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APPENDIX A 



/****************************************************************************** 

* $Header: G : /PVCS/CFG/VCS /TA/SC/SRC/ SHDEBCRE . H_V 1.2 15 Oct 1998 14:10:30 
AMARAL $ 

* 

* Copyright (c) Cubic Transportation Systems, 1997-1998. All Rights Reserved. 
* 

* File: shdebcre.h 

* Desc: Debit/Credit Manager interface routines header file. 

**************************** 

* Version Control Information: 
* 

* $Log: G : /PVCS/CFG/VCS/TA/ SC/ SRC /SHDEBCRE . H_V $ 
* 

* Rev 1.2 15 Oct 1998 14:10:30 AMARAL 

* Added prototype for DBCRDT_ComsStatus ( ) and DBCRDT_COMMS_STATUS enum. 
* 

* Rev 1.1 24 Jul 1998 18:11:26 AMARAL 

* Added parameters to DBCRDT_Init ( ) for DEV_SMADS . 
* 

* Rev 1.0 05 Mar 1998 11:21:52 AMARAL 

* Initial revision. 

****************************************************************************** J 
#ifndef SHDEBCRE_H 

#define SHDEBCRE_H /* Include only once */ 

/* Include Files */ 
/* Defines */ 
/* Typedefs */ 

typedef enum CE_DBCRDT_ERRORS 
{ 

DBCRDT_NO_ERROR = 0, 

DBCRDT_AC_COMMS_U P , 

DBCRDT_AC_COMMS_DOWN , 

DBCRDT_DSM_GET_ERROR, 

DBCRDT_DSM_I N I T_ERROR, 

DBCRDT_DSM_MSG_ERROR , 

DBCRDT_DSM_SAVE__ERROR, 

DBCRDT_DSM_UPDATE_ERROR / 

DBCRDT_DSM_VERSION_ERROR, 

DBCRDT_MEMORY_ERROR, 

DBCRDT_QUEUE_CLOSE_ERROR, 

DBCRDT_QUEUE_CREATE_ERROR, 

DBCRDT_QUEUE_EMPTY_MSG, 

DBCRDT_QUEUE_QUERY_ERROR, 

DBCRDT_QUEUE_READ_ERROR , 

DBCRDT_QUEUE_WRITE_ERROR, 

DBCRDT_SEM_CLOSE_ERROR, 

DBCR DT_S EM_C RE AT E_E RROR , 



DBCRDT_SEM_P0ST__ERROR, 
DBCRDT_SEM_RELEASE_ERROR, 
DBCRDT_SEM_REQUEST_ERROR, 
DBCRDT_SEM_RESET_ERROR, 
DBCRDT_S EM_T IMEOUT_ERROR , 
DBCRDT_THREAD_START__ERROR, 
DBCRDT_MAX_ERRORS 
} DBCRDT_ERRORS; 

typedef enurn CE_DBCRDT_COMMS_STATUS 

{ 

DBCRDT_COMMS_UP - 0, 
DBCRDT_COMMS_R_L I NE_U P , 
DBCRDT_COMMS_DOWN 
) DBCRDT_COMMS STATUS; 



/* Global Variables */ 



/* Prototypes */ 

#if defined{ cplusplus) 

extern "C" 
{ 

#endif 

DBCRDT_COMMS_STATUS DBCRDT_Coms Status (VOID) ; 
VOID DBCRDT_ACComs Disable (VOID) ; 
BOOL DBCRDT_ACComs Disabled (VOID) ; 
VOID DBCRDT__ACComsEnable (VOID) ; 
BOOL DBCRDT_ClearQue (HQUEUE hQueue) ; 

BOOL DBCRDT_Init (USHORT usMajorVer, USHORT usMinorRev 
#ifdef DEV_SMADS 

, INT IHalfSecWaitsForMack 
, INT iSecondsForResend 

#endif 

) ; 

VOID DBCRDT_Percent Free (PLONG plDsmPercentFree) ; 

BOOL DBCRDT_SendToHost {PUCHAR pszMsg, ULONG ulMsgLength, PUCHAR auchlnfo) ; 
VOID DBCRDT_Stop(VOID) ; 

/* Call back functions to be supplied by the calling application */ 
VOID DBCRDT_Display (PCHAR szDispStr) ; 
VOID DBCRDT_DSM_Created (VOID) ; 

VOID DBCRDT_Error (INT iErrorlD, ULONG ulErrorCode, 

PCHAR szFileName, SHORT sLineNo) ; 
BOOL DBCRDT_SendToDevice (PUCHAR pszMsg, USHORT usMsgLength, 

PUCHAR auchlnfo) ; 

#if defined ( cplusplus) 

} 

#endif 



#endif 



APPENDIX B 



* $Header: G : /pvcs/cf g/vcs/ta/smads/src/shdebcre . c_v 1.6 28 Jan 2000 
18:14:00 DYOUNG $ 

* Copyright (c) Cubic Transportation Systems, 1997-1999. All Rights Reserved. 

* File: shdebcre.c 

* Desc: Debit/Credit Manager interface routines. 

* Version Control Information: 

* $Log: G: /pvcs/cf g/vcs/ta/smads/src/shdebcre . c_v $ 

* Rev 1.6 28 Jan 2000 18:14:00 DYOUNG 

* Check for EUB messages after wakeup to send old msgs. 
* 

* Rev 1.12 26 Jan 2000 16:10:42 AMARAL 

* Added support for EUBx messages for TRANSIT AUTHORITY. 
* 

* Rev 1.11 05 Jan 2000 18:52:04 amaral 

* Put type in MACK for unknown message types. 
* 

* Rev 1.10 25 Oct 1999 16:22:38 AMARAL 

* Added check for sent messages when sending to central computer. 

* Rev 1.9 07 Jun 1999 17:14:58 AMARAL 

* AR#158 Debit/Credit module shutdown causes protection a violation. 

* Rev 1.8 13 May 1999 14:13:42 AMARAL 

* AR#138 Fixed EUC2 MACK verification. 

* 

* Rev 1.7 07 May 1999 14:45:02 AMARAL 

* Added processing to handle unexpected MACK EUC2 messages. 
* 

* Rev 1.6 02 Mar 1999 11:26:24 amaral 

* Only resend messages if less than 5 messages on queue to start with. 
* 

* Rev 1.5 15 Oct 1998 16:12:18 AMARAL 

* Added DBCRDT_ComsStatus ( ) to report D/C AC comms status. 

* Implemented controlled thread shutdown. 
* 

* Rev 1.4 27 Jul 1998 15:44:08 AMARAL 

* Corrected transmit length in SHJDCXmit ( ) call in DBCRDT_ACTransmit ( ) . 

* Rev 1.3 24 Jul 1998 18:14:10 AMARAL 

* Changed DBCRDT_ACTransmit ( ) to not disable comms on failed message sent. 
* 

* Rev 1.2 20 May 1998 09:04:04 amaral 

* Change MACK status for EUC2 from MSG_ACKSTS_BUSY to MSG_ACKSTS_ABORT . 

* Rev 1.1 14 Apr 1998 11:24:38 AMARAL 

* Added wait for MACKEUC2 from end device. 

* Rev 1.0 04 Mar 1998 16:09:08 AMARAL 

* Initial revision. 



/* Include Files */ 
#define INCL_DOS 
#define INCL_BASE 
#define INCL_DOSERRGRS 
#define INCL_NOPM 
#include <os2.h> 

iinclude <stdlib.h> 
tinclude <stdio.h> 
ftinclude <string.h> 

# include "shdsmpub.h" 

#include "shapcOOO . h" 

#include "shmsgOO 0 . h" 

#include "shmsgOO 5 . h" 
#ifdef DEV_SMADS 

#include "shmsgOO 6 . h " 
#endif 

#include "shlibOOO . h" 

#include "sherrOOO . h " 

#include "shtimeOO . h" 

^include "shdebcre.h" 



/* Defines */ 
#define DC_RECVQ_QUE_NAME 
#define DC_XMITQ_QUE_NAME 
#define DC_NO_SEMHANDLE 
#define DC__DSM_FILENAME 
#ifdef DEV_SMADS 
#define DC_DSM_FILESI ZE 
#else 

#define DC_DSM_FILESI ZE 
#endif 

#define DC_DSM_SEM_TIMEOUT 
#define DC_MACK_ERROR 
#define DC_STACK_SIZE 
#define DC_INIT_TIMEOUT 
#ifdef DEVJSMADS 
idefine WHITE_BLACK 
#define BLUE_BROWN 
# define RED_CYAN 
#define BLACK_BACK 
#define RED_BACK 
#define BROWN_BACK 
#define CYAN_BACK 
#else 

#define WHITE_BLACK 
#define BLU EMBROWN 
#define RED_CYAN 
# define BLACK_BACK 
tdefine RED_BACK 
tdefine BROWN_BACK 
#define CYAN BACK 



" \ \QUEUES \ \ DBCRDT \ \ DBCRDTRX . QUE " 
" \ \QUEUES \ \ DBCRDT \ \ DBCRDTTX . QUE " 
OUL 

"DEBTCRDT" 

(2L * 1024L * 1024L) 

(16L * 1024L * 1024L) 

5000L 
OxFF 
40960 
3500L 



"\033[40;37m" 

"\033[43;34m" 

"\033[46;31m" 

"\033[40m" 

"\033[41m" 

"\033[43m" 

"\033[46m" 



#endif 



/* Typedefs V 

typedef enum CE_DBCRDT_MSGS 

{ 

DC__MSG_NONE - 0, 
DC_MSG_SEND, 
DC_MSG_EXIT 
} DBCRDT_MSGS; 

typedef struct CS__DBCRDT_GENERIC 
{ 

MSG_C_HEADER header; 

CHAR data [MSG_MAX_LENGTH - sizeof (MSG_C_HEADER) ] ; 

} DBCRDT_GENERIC, *PDBCRDT GENERIC; 



/* Global Variables */ 

static INT 

#ifdef DEV_SMADS 

static INT 

#endif 

static BOOL 

static PVOID 

static HEV 

static HEV 

static HMTX 

static HQUEUE 

static PDBCRDT GENERIC 



DC_iRecvMsgsId, DC_iXmitMsgsId, DC_iManagDSMId; 

DC_iHalf SecWaitsForMack, DC_iSecondsForResend; 

DC_bRunning; 
DC_pCBData; 

DC_I n i t S em , DC_ACXmi t S em ; 

DC_RecvEndSem, DC_XmitEndSem, DC_DSMEndSem; 
DC_DSMSem; 
DC_RecvQ, DC_XmitQ; 
pDC_sExtMsg, pDC_sRcvdMsg; 



static DBCRDT COMMS STATUS DC eCommsSt atus ; 



/* Prototypes */ 

static BOOL DBCRDT 

static UCHAR DBCRDT 

static BOOL DBCRDT^ 

VOID ENV_CDECL DBCRDT 

static UCHAR DBCRDT" 

VOID ENV_CDECL DBCRDT" 

static USHORT DBCRDT" 



VOID ENV CDECL DBCRDT 



DSMAdd ( PUCHAR pMsgPtr, SHORT sMsgLength, 

PUCHAR auchlnfo) ; 
GetLIBResult (ULONG lrc) ; 

GetQueueMsg (HQUEUE hQueue, PUCHAR pszMsg, 

PULONG pulMsgLength, PULONG pulMsgID) ; 
_ManageDSM( PVOID dummy); 
ProcessEC03Msg (MSG_EC03 *psEC03Msg) ; 
RecvMsgs (PVOID dummy) ; 

_Verify_MACK( PVOID pvExtMsg, USHORT usExtMsgLen, 

MSG_C__HEADER *ptMsgHdr, PUCHAR auchlnfo, 
AC_ACCOM_MODE eMode); 

XmitMsgs (PVOID dummy) ; 



/* Call back functions for DSM */ 

BOOL ENV_CDECL DC_DSMRequestSem ( VOID ) ; 

BOOL ENV CDECL DC DSMReleaseSem ( VOID) ; 



* Function: 

* Desc: 

* Inputs: 

* Outputs: 



Debit/Credit Communications Status 

Get the Debit/Credit Communications Status. 

N/A 

Return the Debit/Credit Communications Status, 



* Return Value: N/A 

* External Effects: N/A 

* Implementation: N/A 

****************************************************************************** ^/ 

DBCRDT_COMMS_STATUS DBCRDT_Coms Status (VOID) 
{ 

return DC_eComms Status ; 

} 



/****************************************************************************** 



* Function: Debit /Credit AC Comms Disabled 

* Desc: Test the DC_ACXmitSem. 

* Inputs: N/A 

* Outputs: Return TRUE if the semaphore is reset, else return FALSE. 

* Return Value: N/A 

* External Effects: N/A 

* Implementation: N/A 



*********************************** 
BOOL DBCRDT_ACComs Disabled (VOID) 
{ 

return ( DosWaitEventSem < DC_ACXmitSem, OL) == ERRORJTIMEOUT) ; 

} 



/****************************************************************************** 

* Function: Debit /Credit AC Comms Enable 

* Desc: Enable write to AC transmit queue. 

* Inputs: N/A 

* Outputs: N/A 

* Return Value: N/A 

* External Effects: N/A 

* Implementation: N/A 

****************************************************************************** ^ 

VOID DBCRDT_ACComs Enable (VOID) 

{ 

APIRET rc; 



if ( DBCRDT__ACComs Disabled ( ) ) 
{ 

DC_eCommsStatus = DBCRDT_COMMS__UP; 

DBCRDT_Display { "DBCRDT_ACComsEnable : Area Controller On-Line . \r\n" ) ; 
Hfndef DEV_SMADS 

DBCRDT_Error (DBCRDT_AC_COMMS_UP, OUL, FILE , LINE ); 

#endif 

rc = DosPostEventSem(DC_ACXmitSem) ; 

if (rc && (rc != ERROR_ALREADY__POSTED) ) 

{ 

DBCRDT_Error ( DBCRDT_SEM_POST_ERROR, rc, FILE , LINE ); 

} 

} 

return; 

} 



/****************************************************************************** 
* Function: Debit/Credit AC Comms Disable 



* Desc: Disable write to AC transmit queue. 

* Inputs: N/A 

* Outputs: N/A 

* Return Value: N/A 



* External Effects: N/A 

* Implementation: N/A 

VOID DBCRDT_ACComsDisable (VOID) 
{ 

APIRET rc; 

ULONG ulPostCount; 

if (DBCRDT_ACComsDisabled() ) /* AC Comms are already disabled */ 

return; 

DC_eCommsStatus - DBCRDT_COMMS_DOWN; 

DBCRDT_Display ( "DBCRDT_ACComs Dis able : Area Controller Of f -Line . \r\n" ) ; 
#ifndef DEV^SMADS 

DBCRDT_Error ( DBCRDT_AC_COMMS_DOWN, OUL, FILE , LINE ); 

#endif 

rc = DosResetEventSem(DC_ACXmitSem / &ulPostCount ) ; 

if (rc && (rc != ERROR_ALREADY_RESET) ) 

{ 

DBCRDT_Error ( DBCRDT_SEM__RESET_ERROR, rc, FILE , LINE ); 

} 

return; 

} 



* Function: Clear Debit/Credit Receive Queue 

* Desc: Clear Debit/Credit receive queue. 

* Inputs: N/A 

* Outputs: N/A 

* Return Value: N/A 



* External Effects: N/A 

* Implementation: N/A 

BOOL DBCRDT_ClearQue (HQUEUE hQueue) 
{ 

APIRET rc; 

ULONG ulMsgsInQ, ulMsgLength; 

BYTE bMsgPriority; 
PVOID pvMsgAddr; 
REQUESTDATA PidData; 

rc = DosQueryQueue (hQueue , &ulMsgsInQ) ; 

if (rc) 

{ 

DBCRDT_Error ( DBCRDT_QUEUE_QUERY_ERROR, rc, FILE , LINE ); 

return FALSE; 

} 

while (ulMsgsInQ) /* While there are messages in the queue */ 
{ /* Read the queue and free the message memory */ 

rc = DosReadQueue (hQueue, SPidData, &ulMsgLength, spvMsgAddr, OL, 

DCWW_WAIT, &bMsgPriority, DC_NO_SEMHAN DLE ) ; 



if (rc) 
{ 

DBCRDT_Error (DBCRDT_QUEUE_READ__ERROR, rc, FILE , LINE ); 

return FALSE; 

} 

/* Free the message buffer */ 
f ree (pvMsgAdclr ) ; 
ulMsgsInQ-- ; 

} 

return TRUE; 
} /* DBCRDT ClearQue */ 



* Function: Acid Message To DSM 

* Desc: Add Debit/Credit message to DSM. 

* Inputs: N/A 

* Outputs: N/A 

* Return Value: N/A 

* External Effects: N/A 

* Implementation: N/A 

static BOOL DBCRDT_DSMAdd ( PUCHAR pMsgPtr, SHORT sMsgLength, PUCHAR auchlnfo) 
{ 

DSM_FILE_ERRORS rc; 

ULONG ulKey, ulDatimStamp; 

LONG lMsgFP; 
DSM_CBUF_HDR tDiskMsgHdr; 

ulKey = ( (MSG_C_HEADER *) pMsgPtr ) ->cics_trans_no . v; 

if <DSM_SearchKey (DC_pCBData, ulKey, &tDiskMsgHdr , SlMsgFP) != DSM_MSG_OK) 
{ /* Not found, save it */ 

ulDatimStamp - SHTIM__time ( ) ; 

rc = DSM_MsgSave (DC_pCBData, pMsgPtr, DSM_MSG_NONPRIORITY, auchlnfo, 

ulKey, sMsgLength, ulDatimStamp, &lMsgFP) ; 
if (rc != DSM_FILE_OK) 

DBCRDT_Error (DBCRDT_DSM_SAVE_ERROR, rc, FILE , LINE ) ; 

} 

else /* Duplicate already exists */ 

{ 

rc = DSM_FILE_N0_R0OM_ERROR; /* Set error so message doesn't xmit */ 
DBCRDT_Display ( "DBCRDT_DSMAdd: Duplicate message ignored . \r\n" ) ; 

} 

return (rc == DSM_FILE_OK) ; 
} /* DBCRDT DSMAdd */ 



* Function: DSM Request Semaphore 

* Desc: Request semaphore for DSM access. 

* Inputs: N/A 

* Outputs: N/A 

* Return Value: N/A 

* External Effects: N/A 

* Implementation: N/A 
*******++********+**************^ 

BOOL ENV_CDECL DC_DSMRequestSem (VOID) 



{ 

APIRET rc; 



rc = DosRequestMutexSem(DC_DSMSem, DC_DSM_SEM__TIMEOUT ) ; 

if (rc) 

{ 

DBCRDT_Error ( DBCRDT_SEM_REQUEST_ERROR, rc, FILE , LINE ); 

return TRUE; 

} 

return FALSE; 
} /* DC_DSMRequestSem */ 



* Function: DSM Release Semaphore 

* Desc: Release semaphore for DSM access. 

* Inputs: N/A 

* Outputs: N/A 

* Return Value: N/A 

* External Effects: N/A 

* Implementation: N/A 

BOOL ENV_CDECL DC_DSMReleaseSem ( VOID) 
{ 

APIRET rc; 

rc = DosReleaseMutexSem (DC_DSMSem) ; 

if (rc) 

{ 

DBCRDT_Error { DBCRDT_SEM_RELEASE__ERROR, rc, FILE , LINE ) ; 

return TRUE; 

} 

return FALSE; 
} /* DC DSMReleaseSem */ 



Function : 
Desc : 
Inputs : 



Outputs : 
Return Value: 
External Effects: 
Implementation : 



Debit/Credit Get Queue Message 

Get a Debit/Credit message of the given queue. 

HQUEUE hQueue - Handle of queue to get message from. 

PUCHAR pszMsg - Pointer of buffer to place message. 

PULONG ulMsgLength - Pointer to store message data length 

N/A 

TRUE if message retrieved else FALSE. 

N/A 

N/A 



static BOOL DBCRDT_GetQueueMsg (HQUEUE hQueue, PUCHAR pszMsg, 



{ 



PULONG pulMsgLength, PULONG pulMsgID) 



APIRET rc; 

ULONG ulMsgsInQ; 

BOOL bRc; 

UCHAR ucMsgPriority; 

PVOID pvMsgAddr; 

REQUESTDATA PidData; 



bRc = FALSE; 

rc = DosQueryQueue (hQueue, SulMsgsInQ) ; 
if (rc) 

DBCRDT_Error ( DBCRDT_QUEUE_QUERY_ERROR, rc, FILE , LINE ); 

else if (ulMsgsInQ) 

{ /* Get message fromn Debit/Credit receive queue */ 

rc = DosReadQueue (hQueue, &PidData, pulMsgLength, &pvMsgAddr, OL, 

DCWW_WAIT, &ucMsgPriority, DC_NO_SEMHANDLE ) ; 

if (rc) 

DBCRDT_Error { DBCRDT_QUEUE_READ_ERROR, rc, FILE , LINE ); 

else 

{ /* Free the response message buffer */ 
*pulMsgID - PidData.ulData; 
memcpy (pszMsg, pvMsgAddr, *pulMsgLength) ; 
free (pvMsgAddr) ; 

bRc - TRUE; /* Message retrieved */ 

} 

} 

return bRc; 
} /* DBCRDT_GetQueueMsg */ 



* Function: Debit /Credit Initialize 

* Desc: Initialize Debit/Credit routines. 

* Inputs: N/A 

* Outputs: N/A 

* Return Value: N/A 

* External Effects: N/A 

* Implementation: N/A 
********************************^ 

BOOL DBCRDT_Init (USHORT usMajorVer, USHORT usMinorRev 
#ifdef DEV_SMADS 

, INT iHalfSecWaitsForMack 
, INT iSecondsForResend 

#endif 



APIRET rc; 

ULONG ulPostCount ; 

DSM_FILE_ERRORS dsmRc; 

DC_eCommsStatus - DBCRDT_COMMS_DOWN; 

/* Initialize memory */ 

rc = DosAllocSharedMem( (PVOID) &pDC_sExtMsg, NULL, sizeof { DBCRDT_GENERIC ) , 

PAG_COMMIT | OB J__G I VEABLE | PAG_WRITE); 

if (rc) 
{ 

DBCRDT_Error (DBCRDT_MEMORY_ERROR, rc, FILE , LINE ); 

return FALSE; 

} 

rc = DosAllocSharedMem( (PVOID) &pDC_sRcvdMsg, NULL, sizeof ( DBCRDT_GENERIC) , 

PAG_COMMIT | OB J_G I VEABLE | PAG_WRITE) ; 

if (rc) 
{ 

DBCRDT Error (DBCRDT MEMORY ERROR, rc, FILE , LINE ); 



return FALSE; 

} 

/* Initialize semaphores */ 

rc = DosCreateEventSem{NULL, &DC_InitSem, OL, FALSE); 
if (rc) 
{ 

DBCRDT__Error ( DBCRDT_SEM__CREATE_ERROR, rc, FILE , 

return FALSE; 

} 

rc = DosCreateEventSem (NULL, &DC_ACXmitSem, OL, TRUE); 
if (rc) 
{ 

DBCRDT_Error (DBCRDT_SEM_CREATE_ERROR, rc, FILE , 

return FALSE; 

} 

rc = DosCreateMutexSem (NULL, &DC_DSMSem, OL, FALSE); 
if (rc) 
{ 

DBCRDT_Error (DBCRDT_SEM_CREATE_ERROR, rc, FILE , 

return FALSE; 

} 

rc = DosCreateEventSem (NULL, &DC_RecvEndSem, OL, FALSE); 
if (rc) 
{ 

DBCRDT_Error (DBCRDT_SEM_CREATE_ERROR, rc, FILE , 

return FALSE; 

} 

rc = DosCreateEventSem (NULL, &DC_XmitEndSem, OL, FALSE); 
if (rc) 
{ 

DBCRDT_Error (DBCRDT_SEM_CREATE_ERROR, rc, FILE , 

return FALSE; 

} 

rc = DosCreateEventSem (NULL, &DC_DSMEndSem, OL, FALSE); 
if (rc) 
{ 

DBCRDT_Error (DBCRDT_SEM_CREATE_ERROR, rc, FILE , 

return FALSE; 

} 

/* Initialize queues */ 
rc - DosCreateQueue (&DC_RecvQ, QUE_FIFO, DC__RECVQ_QUE_NAME) ; 
if (rc) 
{ 

DBCRDT_Error (DBCRDT_QUEUE_CREATE_ERROR, rc, FILE , LINE 

return FALSE; 

} 

rc = DosCreateQueue (&DC_XmitQ, QUE_PRIORITY, DC__XMITQ_QUE_NAME) ; 

if (rc) 

{ 

DBCRDT_Error ( DBCRDT_QUEUE_CREATE_ERROR, rc, FILE , LINE 

return FALSE; 

} 

/* Initialize DSM */ 
do 



LINE ) 



LINE ) 



LINE ) 



LINE ) 



LINE ) 



LINE ) 



{ 

dsmRc = DSM__CBufInit (&DC_pCBData, DC_DSM_FI LENAME , DC_DSM_FILESIZE, 

FALSE, usMajorVer, usMinorRev, 
DC_DSMRequestSem, DC_DSMReleaseSem) ; 

if (dsmRc == DSM_FILE_WRONG_VERSION) 

{ 

DBCRDT_Error (DBCRDT_DSM_VERSION_ERROR, dsmRc, FILE , LINE ); 

DBCRDT__Display ( "DBCRDT_Init : DSM is wrong version, " 

"updating version. \r\n" ) ; 
DSMJJpdateVersion (DC_pCBData, usMajorVer, usMinorRev, FALSE) ; 

} 

} while (dsmRc == DSM_FILE_WRONG_VERSION) ; 
if (dsmRc D S M_F I LE_C RE AT E D ) 

DBCRDT_DSM_Created( ) ; 
else if (dsmRc != DSM_FILE_OPENED) 
{ 

DBCRDT_Error (DBCRDT_DSM_INIT_ERROR, dsmRc, FILE , LINE ); 

return FALSE; 

} 

/* Start threads */ 
DC_bRunning = TRUE; 

rc = DosResetEventSem (DC_InitSem, &ulPostCount) ; 

if (rc && rc != ERROR_ALREADY_RESET ) 

{ 

DBCRDT_Error { DBCRDT_SEM_RESET__ERROR, rc, FILE_, LINE ); 

return FALSE; 

} 

DC_iRecvMsgsId - _beginthread ( DBCRDT_RecvMsgs , NULL, DC_STACK_SIZE, NULL); 

if (DC_iRecvMsgsId == -1) 

{ 

DBCRDT_Error (DBCRDT_THREAD_START_ERROR, (ULONG) DC_iRecvMsgsId, 
FILE , LINE ) ; 

return FALSE; 

} 

rc = DosWaitEventSem(DC_InitSem, DC_INIT_TIMEOUT) ; 

if (rc) 

{ 

DBCRDT_Error ( DBCRDT_SEM_TIME0UT_ERROR, rc, FILE , LINE ); 

return FALSE; 

} 

rc = DosResetEventSem(DC_InitSem, &ulPostCount) ; 

if (rc && rc != ERROR_ALREADY_RESET ) 

{ 

DBCRDT_Error (DBCRDT_SEM_RESET_ERROR, rc, FILE , LINE ) ; 

return FALSE; 

} 

DC_iXmitMsgsId = _beginthread (DBCRDT__XmitMsgs, NULL, DC_STACK_SIZE, NULL); 

if (DC_iXmitMsgsId == -1) 

{ 

DBCRDT_Error (DBCRDT_THREAD_START_ERROR, (ULONG) DC_iXmitMsgsId, 
FILE , LINE ) ; 

return FALSE; 

} 

rc = DosWaitEventSem (DC__InitSem, DC_INIT_TIMEOUT) ; 
if (rc) 



{ 

DBCRDT_Error (DBCRDT_SEM_TIMEOUT_ERROR, rc, FILE , LINE ); 

return FALSE; 

} 

rc = DosResetEventSem(DC_InitSem, SulPostCount) ; 

if (rc && rc != ERROR_ALREADY_RESET ) 

{ 

DBCRDT_Error (DBCRDT_SEM_RESET_ERROR, rc, FILE , LINE ); 

return FALSE; 

} 

DC_iManagDSMId - Joeginthread ( DBCRDT_ManageDSM, NULL, DC_STACK_SIZE, NULL) 

if (DC_iManagDSMId == -1) 

{ 

DBCRDT_Error ( DBCRDT_THREAD_START_ERROR, (ULONG) DC_iManagDSMId, 
_ FILE , LINE ) ; 

return FALSE; 

} 

rc = DosWaitEventSem(DC_InitSem, DC_INIT_TIMEOUT) ; 

if (rc) 

{ 

DBCRDT_Error { DBCRDT_SEM_TIMEOUT_ERROR, rc, FILE_, LINE ); 

return FALSE; 

} 



#ifdef DEV_SMADS 

/* Set up wait times passed in from application */ 
DC_iHalf SecWaitsForMack = iHalf SecWaits ForMack; 
DC_iSecondsForResend = iSecondsForResend; 

#endif 



DC_eCommsStatus = DBCRDT_COMMS_UP; 
return DC_bRunning; 
} /* DBCRDT Init */ 



* Function: 

* Desc: 

* Inputs : 



Outputs : 



Return Value: 
External Effects: 
Implementation : 



Debit/Credit 
Determine pe 
pulDsmFree i 
of the Debit 
The percenta 
hundredths o 
value of 100 
10000, where 
N/A 
N/A 
N/A 



Percent Free 
rcentage of free space available in DSM file, 
s a pointer to store the percentage available 
/Credit DSM files. 

ge available is an long value represented in 
f a percent, i.e. a value of 1 is 00.01% and a 
00 is 100.00%. The valid range is -1 to 
1 means the value could not be determined. 



VOID DBCRDT_PercentFree (PLONG plDsmPercentFree) 



LONG 



lFreeSpace; 



DSM_CBuf Usage (DCjpCBData, &lFreeSpace) ; 
if (lFreeSpace -1L) 

^plDsmPercentFree = -1L; 

else 



*plDsmPercentFree = (LONG) (((double) lFreeSpace * 10000) / 

DC DSM FILESIZE) 



return; 

} 



* Function: 

* Desc: 



Debit/Credit Receive Messages 

Receive Debit /Credit messages from host computer. This 
thread handles EC03, EUCO, EUC2, and MACKEUC2 messages 
only . 
N/A 
N/A 
N/A 



* Inputs: 

* Outputs : 

* Return Value: 

* External Effects: N/A 

* Implementation: N/A 

VOID ENV_CDECL DBCRDT_RecvMsgs ( PVOID dummy) 

{ 



APIRET 
INT 

USHORT 
ULONG 
BOOL 
UCHAR 
UCHAR 
UCHAR 
PVOID 

REQUESTDATA 

DBCRDT_GENERIC 

PDBCRDT_GENERIC pMsg = NULL; 

MSG_EUC2 
tifdef DEV_SMADS 

MSG_EUB2 
#endif 

MSG_C_MACK 

AC_ACCOM_MODE 

INT 



rc; 
iLcv; 

usErr, usLength, usIntLen; 
ulRc, ulMsgLength, ulMsgsInQ; 
bRunning, bDone; 
MsgPriority; 

szMsgType [MSG_ID_TYPE_MAX] , szBuf fer [82] ; 
szMsg[MSG_MAX_LENGTH] , auchlnf o [ DSM_INFO_SI ZE] ; 
MsgAddr ; 
PidData; 
slntMsg; 



t psEUC2Msg; 

*psEUB2Msg; 

sMackMsg; 
eMode ; 
iWait ; 



/* Number of half seconds to wait */ 
/* for response in DC_RecvQ */ 



/* Local Initialization */ 
bRunning = TRUE; 



rc = DosAllocSharedMem( (PVOID) &pMsg, NULL, sizeof ( DBCRDT_GENERIC) , 

PAG_COMMIT | OBJjGIVEABLE | PAG_WRITE) ; 

if (rc) 
{ 

DBCRDT_Error (DBCRDT_MEMORY_ERROR, OUL, FILE ., LINE ) ; 

bRunning = FALSE; 

} 



/* Post 'Initialized 1 semaphore */ 

rc = DosPostEventSem(DC_InitSem) ; 

if (rc && (rc != ERROR_ALREADY_POSTED) ) 

{ 

DBCRDT_Error (DBCRDT_SEM_POST_ERROR, rc, FILE , LINE ); 

if (bRunning) 



DosFreeMem (pMsg) ; 
bRunning = FALSE; 



/* Init the AC recv mode */ 

eMode = AC_RECV_MODE; 

while (bRunning && DC_bRunning) 

{ 

usErr = SH_DCRecv (pMsg, eMode, &usLength) ; 

if (usErr == AC__ERROR__OK) 

{ 

if {usLength == 0) /* Session was deallocated */ 

{ 

eMode = AC_RECV_MODE; 

usLength = sizeof ( DBCRDT_GENERIC) ; 

/* Remove all messages from receive queue */ 

DBCRDT_ClearQue (DC_RecvQ) / 

continue; 

} 

/* Only EC03, EUCO, & EUC2 messages are received */ 
/* Default to one second wait for response */ 
iWait = 2; 

/* Receive any message from the AC then enable */ 
/* transmit to AC if previously disabled. */ 
if { DBCRDT_ACComsDisabled ( ) ) 
{ 

DBCRDT_ACComs Enable ( ) ; 

} 

DC_eCommsStatus = DBCRDT_COMMS_UP; 
usIntLen = usLength; 

ulRc = LIB_msg_byte_to__strc ( (PUCHAR) pMsg, &sIntMsg, &usIntLen) ; 

sprintf {szBuf fer, RED_CYAN "Rx %4.4s Len 0x%x" WHITE_BLACK "\r\n", 

slntMsg . header . type, usLength); 
DBCRDT_Display (szBuf fer) ; 

/* Clear D/C receive queue of unexpected messages */ 
rc = DosQueryQueue (DC_RecvQ, &ulMsgsInQ) ; 
if (rc) 
{ 

DBCRDT_Error ( DBCRDT_QUEUE_QUERY_ERROR, rc, FILE , LINE ); 

ulMsgsInQ = OUL; 

} 

while (ulMsgsInQ) 
{ 

rc = DosReadQueue (DC_RecvQ, &PidData, &ulMsgLength, 

&MsgAddr, OL, DCWW_WAIT, 
SMsgPriority, DC_NO_SEMHANDLE) ; 

if (rc) 
{ 

DBCRDT_Error (DBCRDT_QUEUE_READ_ERROR, rc, 
FILE , LINE ) ; 



} 

else if (PidData.ulData == DC_MSG__EXIT ) 
{ 

bRunning = FALSE; 

} 

ulMsgsInQ--; 
free (MsgAddr) ; 



/* Create MACK message */ 

memcpy ( sMackMsg . mack_id, MSG_ID_MACK, MSG_ID_TYPE_MAX) ; 
memcpy (sMackMsg. type, slntMsg . header . type , MSG_ID_TYPE_MAX ) ; 
sMackMsg . cics_trans_no . v = slntMsg . header . cics_trans_no . v; 
sMackMsg. status = DBCRDT_GetLIBResult (ulRc) ; 
if (ulRc !- LIB_SUCCESS) 
{ 

LIB_cnv_ebcdic_to_ascii ( (PUCHAR) pMsg, (PUCHAR) &sIntMsg, 

MSG_ID_TYPE_MAX) ; 

DBCRDT_Error (DBCRDT_DSM_MSG_ERROR, ulRc, FILE , LINE ); 

/* Transmit the non-zero MACK */ 
LIB_msg_tx_mack (& sMackMsg, szMsg, &usIntLen) ; 
DBCRDT_SendToHost (szMsg, (ULONG) usIntLen, NULL); 

} 

else if (! strncmp ( slntMsg . header .type, MSG_ID_EC03, 

MSG_ID_TYPE_MAX) ) 
{ /* Transmit the MACK EC03 */ 

sMackMsg. status = DBCRDT_ProcessEC03Msg ( (MSG_EC03 *) &sIntMsg) ; 

LIB_msg_tx_mack (SsMackMsg, szMsg, &usIntLen) ; 

DBCRDT_SendToHost (szMsg, (ULONG) usIntLen, NULL); 

} 

else if (! strncmp (slntMsg. header .type, MSG_ID_EUCO, 

MSG_ID_TYPE_MAX) ) 
{ /* Transmit the MACK EUCO */ 

LI B_ms g_t x_mack (& sMackMsg, szMsg, &usIntLen) ; 

DBCRDT_SendToHost (szMsg, (ULONG) usIntLen, NULL); 

#ifdef DEV_SMADS 

DBCRDT_SendToDevice ( (PUCHAR) pMsg, MSG_ID_TYPE_MAX, auchlnfo) ; 

#endif 



} 

else if (! strncmp (slntMsg. header. type, MSG_ID_EUC2, 

MSG_ID_TYPE_MAX) ) 
{ /* Send EUC2 to end device */ 

psEUC2Msg = (MSG_EUC2 *) &sIntMsg; 

/* This message originates at the AC. The MACKEUC2 */ 
/* message that is sent in response is put on the */ 
/* receive queue, DC_RecvQ. */ 
LIB_cnv_ebcdic_to_ascii ( 

psEUC2Msg->f data . common__iso_data_2 . card_accp_term id, 
psEUC2Msg->f dat a . common_iso_data_2 . card_accp_term_id, 
CARD_ACCP_TERMINAL_ID_MAX) ; 
/* Get the SCP from the terminal ID */ 
auchlnfo[0] = 

psEUC2Msg->f data . common_iso_data_2 . card_accp_term_id [ 4 ] - 1 0 ' ; 
auchlnfofl] = 

psEUC2Msg->fdata . common_iso_data_2 . card_accp_term_id [5] - ' 0' ; 
auchlnfo [2] = 



( (psEUC2Msg->fdata . common_iso_data_2 . card_accp_term__id [ 6] - 

'0' ) * 10) + 

psEUC2Msg->f data . common_iso_data_2 . card_accp_term_id [7 ] - ' 0 ' ; 

/* Send EUC2 to device that sent the EUC1 or EUC6 */ 

if ( ! DBCRDT_SendToDevice ( (PUCHAR) pMsg, usLength, auchlnfo) ) 

{ /* Can f t send to device, transmit a non-zero MACK */ 

sMackMsg. status - MSG_ACKSTS_ABORT ; 

LIB_msg_tx_mack ( &sMackMsg, szMsg, &usIntLen) ; 

DBCRDT__SendToHost (szMsg, (ULONG) usIntLen, NULL) ; 

} 

else 



/* 


For EUC2, we should get a MACK back from the 


*/ 


/* 


device. Make sure we wait long enough for 


*/ 


/* 


longest possible time allowed to get a 


*/ 


/* 


repsonse back from device, including possible 


*/ 


/* 


re-transmit cases. 


*/ 



#ifdef DEV__SMADS 

iWait = DC_iHalfSecWaitsForMack; 

#else 

iWait = 60; 

#endif 

} 

> 

#ifdef DEV_SMADS 

else if (! strncmp (slntMsg. header . type, MSG_ID_EUB2, 

MSG_ID_TYPE_MAX) ) 
{ /* Send EUB2 to end device */ 

psEUB2Msg = (MSG_EUB2 *) SsIntMsg; 

/* This message originates at the AC. The MACKEUB2 */ 
/* message that is sent in response is put on the */ 
/* receive queue, DC_RecvQ. */ 
LIB_cnv_ebcdic_to_ascii ( 

&psEUB2Msg->f data . tEUB_Hdr . ca rd_accp_term_id [ 0 ] , 
&psEUB2Msg->f data . tEUB_Hdr . card_accp_term_id [ 0 ] , 
MSG_EUC5_CARD_ACCP_ID_MAX) ; 
/* Get the SCP from the terminal ID */ 
auchlnfo [0] = 

psEUB2Msg->fdata. tEUB_Hdr . card_accp_term_id [ 4 ] - ! 0' ; 
auchlnfo [1] = 

psEUB2Msg->fdata. tEUB_Hdr . card_accp_term_id [5] - f 0' ; 
auchlnfo [2] = 

( (psEUB2Msg->fdata.tEUB_Hdr.card_accp_term_id[6] - '0') * 10) + 
psEUB2Msg->fdata.tEUB_Hdr.card_accp__term_id[7] - ' 0' ; 

/* Send EUB2 to device that sent the EUB1 */ 

if ( ! DBCRDT_SendToDevice ( ( PUCHAR) pMsg, usLength, auchlnfo) ) 
{ /* Can't send to device, transmit a non-zero MACK */ 

sMackMsg. status = MSG_ACKSTS_ABORT; 

LIB_rnsg_tx_mack(&sMackMsg, szMsg, &usIntLen) ; 

DBCRDT_SendToHost (szMsg, (ULONG) usIntLen, NULL) ; 

} 

else 

{ /* For EUB2, we should get a MACK back from the */ 
/* device. Make sure we wait long enough for V 
/* longest possible time allowed to get a */ 
/* repsonse back from device, including possible */ 



/* re-transmit cases. */ 
iWait = DC_iHalf SecWaitsForMack; 

} 

} 

#endif 

else /* The message is unknown and not processed */ 

{ 

DBCRDT_Error ( DBCRDT_DSM_MSG_ERROR, LI B_W_MSG_UN KNOWN, 

FILE , LINE ) ; 

/* Transmit the non-zero MACK */ 
sMackMsg. status = MSG_ACKSTS_TRANSIDINV; 
LIB_msg_tx_mack (SsMackMsg, szMsg, &usIntLen) ; 
DBCRDT_SendToHost (szMsg, (ULONG) usIntLen, NULL); 

} 

eMode = AC_RECV_MODE; 
ulMsgsInQ = OUL; 
bDone = FALSE; 

for {iLcv = 0; (iLcv < iWait) && IbDone; iLcv++) 

{ /* Check for a queue message for up to given halve seconds V 
rc = DosQueryQueue (DC_RecvQ, &ulMsgsInQ) ; 
if (rc) 
{ 

DBCRDT_Error (DBCRDT_QUEUE_QUERY_ERROR, rc, 

FILE , LINE ) ; 

ulMsgsInQ - OUL; 

} 

if ( !ulMsgsInQ) 
{ 

DosSleep (500L) ; 

} 

else 
{ 

do 
{ 

rc = DosReadQueue (DC_RecvQ, &PidData, SulMsgLength, 
&MsgAddr, 0L, DCWW_WAIT, 
SMsgPriority, DC_NO_SEMHANDLE) ; 

if (rc) 

DBCRDT_Error ( DBCRDT_QUEUE_READ__ERROR, rc, 
FILE , LINE ) ; 

else if (PidData.ulData == DC_MSG_EXIT) 

bRunning = FALSE; 
bDone = TRUE; 

else 

{ /* If waiting for an EUB2/EUC2, verify MACK */ 
/* matches current EUB2/EUC2 message. Also */ 
/* verify that the cics_trans_no.v matches */ 
usLength = (USHORT) ulMsgLength; 
memcpyfpMsg, MsgAddr, ulMsgLength) ; 

/* Display Message header */ 
LIB_cnv__ebcdic_to_ascii (MsgAddr, szMsgType, 



MSG_ID_TYPE_MAX) ; 
if ( ! strncmp (szMsgType, MSG_ID_MACK, 

MSG_ID_TYPE_MAX) ) 
{ /* Received a MACK */ 

if (LIB_msg_rx_mack< (PUCHAR) MsgAddr, 

SsMackMsg, 

SusLength) == LIB_SUCCESS ) 
{ /* Verify the CICS # of the MACK */ 
if ( sMackMsg . cics_trans_no . v == 

slntMsg . header . cics_trans_no . v 
{ /* This is the correct MACK */ 
sprint f (szBuff er, CYANJ3ACK 

"Rx MACK %4.4s Status %d" 
BLACK_BACK "\r\n" f 
sMackMsg . type, 
sMackMsg. status) ; 
/* CICS numbers match V 
bDone = TRUE; 

/* Go back to top and send */ 
/* the response in pMsg */ 
eMode = AC_XMITJMODE; 

} 

else 

{ /* Wrong MACK for current message */ 
sprintf (szBuf fer, RED_BACK 

"Rx WRONG MACK %4.4s Status %d 
BLACK_BACK "\r\n", 
sMackMsg . type, 
sMackMsg . status ) ; 

} 

} 

else 

{ /* Invalid MACK received */ 

sprintf (szBuf fer, CYAN_BACK "Rx MACK " 
"Unknown" BLACK_BACK "\r\n"); 

} 

} 

else 

{ /* Display non-MACK message received */ 
sprintf (szBuf fer, CYAN_BACK "Rx %4.4s" 
BLACK_BACK "\r\n", szMsgType); 

} 

DBCRDT_Display (szBuf fer) ; 

} 

ulMsgsInQ — ; 
if (!rc) 

{ /* Free the response message buffer */ 
free (MsgAddr) ; 

} 

} while (ulMsgsInQ && IbDone); 

} 

( IbDone) 

/* Timed out */ 

sprintf (szBuffer, RED_BACK 

"Timed out waiting for response to %4.4s." BLACK_BACK 

"\r\n", s I ntMsg. header . type) ; 



DBCRDT_Di splay ( szBuf f er ) ; 

} 

} 

else 
{ 

#if FALSE /* Don't allow comms to get disabled */ 

if ( ! DBCRDT_ACComsDisabled( ) ) /* Comms enabled, disable it */ 
{ 

DBCRDT_ACComs Disable ( ) ; 

} 

#endif 

sprintf (szBuffer, RED_BACK " DBCRDT_RecvMsgs : SH_DCRecv error, " 

"mode=%d, err=%d. " BLACK_BACK "\r\n", eMode, usErr) ; 
DBCRDT_Display (szBuffer) ; 

DosSleep (30000L) ; /* Sleep 30 seconds on receive error */ 

/* Go back to a known state waiting to receive */ 
eMode = AC_RECV_MODE; 

} 

} 

DosFreeMem (pMsg) ; 



DC_iRecvMsgsId = -1; 

/* Post 'Closing' semaphore */ 

rc = DosPostEventSem (DC_RecvEndSem) ; 

if (rc && (rc != ERROR_ALREADY_POSTED) ) 

{ 

DBCRDT_Error (DBCRDT_SEM_POST_ERROR, rc, FILE , LINE ) ; 

} 



dummy = dummy; 
_endthread ( ) ; 
} / + DBCRDT_RecvMsgs */ 



* Function: Debit /Credit Stop 

* Desc: Stop Debit/Credit threads, release memory, and close queus . 

* Inputs: N/A 

* Outputs: N/A 

* Return Value: N/A 

* External Effects: N/A 

* Implementation: N/A 
********** 

VOID DBCRDT_Stop(VOID) 
{ 

API RET rc; 

ULONG ulPriority, ulPostCount; 

DBCRDT_Display ( "DBCRDT_Stop : Stopping Debit/Credit Comms . \r\n" ) ; 



DBCRDT_ACComs Disable ( ) ; /* Stop AC comms */ 

/* Stop threads */ 

rc = DosResetEventSem(DC_RecvEndSem, &ulPostCount ) ; 
if (rc && rc != ERROR_ALREADY_RESET) 

DBCRDT_Error (DBCRDT_SEM_RESET_ERROR, rc, FILE , LINE ); 



rc = DosResetEventSem (DC_XmitEndSem, &ulPostCount ) ; 
if (rc && rc != ERROR_ALREADY_RESET ) 

DBCRDT__Er ror ( DBCRDT_SEM_RESET_ERROR, rc, FILE , LINE ); 

rc = DosResetEventSem ( DC_DSMEndSem, &ulPostCount) ; 
if (rc && rc != ERROR_ALREADY_RESET ) 

DBCRDT_Error (DBCRDT_SEM_RESET_ERROR, rc, FILE^ , LINE ) ; 

/* Send signals to stop threads */ 
DC_bRunning = FALSE; 
ulPriority = 15; 

rc = DosWriteQueue (DC_RecvQ, DC_MSG_EXIT, OUL, NULL, ulPriority); 
if (rc) 

DBCRDT_Error (DBCRDT_QUEUE_WRITE_ERROR, rc, FILE , LINE ) ; 

rc - DosWriteQueue (DC_XmitQ, DC_MSG_EXIT, OUL, NULL, ulPriority); 
if (rc) 

DBCRDT_Error (DBCRDT_QUEUE_WRITE_ERROR, rc, FILE , LINE ); 

/* Wait for threads to stop */ 

rc = DosWaitEventSerMDC^DSMEndSem, DC_INIT_TIMEOUT) ; 

if (rc) 

{ 

DBCRDT_Error (DBCRDT_SEM_TIMEOUT_ERROR, rc, FILE , LINE ) ; 

if (DC_iManagDSMId != -1) 
{ 

DosKillThread(DC_iManagDSMId) ; 

DBCRDT_Display ( "DBCRDT_Stop : Killed DSM thread ! \r\n" ) ; 

} 

} 

rc = DosWaitEventSem(DC_XmitEndSem, DC_INIT_TIMEOUT ) ; 

if (rc) 

{ 

DBCRDT_Error (DBCRDT_SEM_TIMEOUT_ERROR, rc, FILE , LINE ); 

if {DC_iXmitMsgsId != -1) 
{ 

DosKillThread(DC_iXmitMsgsId) ; 

DBCRDT_Display ( " DBCRDT_Stop : Killed Transmit thread ! \r\n" ) ; 

} 

} 

rc = DosWaitEventSem{DC_RecvEndSem, DC_INIT_TIMEOUT ) ; 

if (rc) 

{ 

#ifndef DEV_SMADS 

DBCRDT_Error (DBCRDT_SEM_TIMEOUT_ERROR, rc, FILE , LINE ); 



#endif 



if (DC_iRecvMsgsId != -1) 
{ 

DosKillThread ( DC_iRecvMsgsId) ; 

DBCRDT_Display("DBCRDT_Stop: Killed Receive thread ! \r\n" ) ; 

} 



} 



/* Close queues */ 

DBCRDT_ClearQue (DC_RecvQ) ; /* Release message memory on queue */ 

rc = DosCloseQueue (DC_RecvQ) ; 
if (rc) 

DBCRDT_Error ( DBCRDT_QUEUE_CLOSE_ERROR, rc, FILE , LINE ); 

DBCRDT_ClearQue (DC_XmitQ) ; /* Release message memory on queue */ 



rc = DosCloseQueue (DC_XmitQ) ; 
if (rc) 

DBCRDT_Error ( DBCRDT_QUEUE_CLOSE_ERROR, rc, FILE , LINE ); 

/* Close semaphores */ 
rc = DosCloseEventSem (DC_InitSem) ; 
if (rc) 

DBCRDT_Error ( DBCRDT_SEM_CLOSE_ERROR, 
rc = DosCloseEventSem ( DC_ACXmitSem) ; 
if (rc) 

DBCRDT_Error ( DBCRDT_SEM__CLOSE_ERROR, 
rc = DosCloseMutexSem(DC_DSMSem) ; 
if (rc) 

DBCRDT__Error ( DBCRDT_SEM_CLOSE_ERROR, 
rc = DosCloseEventSem (DC_RecvEndSem) ; 
if (rc) 

DBCRDT_Error ( DBCRDT_SEM_CLOSE_ERROR, 
rc = DosCloseEventSem (DC_XmitEndSem) ; 
if (rc) 

DBCRDT_Er ror ( DBCRDT_SEM_CLOSE_ERROR, 
rc = DosCloseEventSem (DC_DSMEndSem) ; 
if (rc) 

DBCRDT_Error ( DBCRDT_SEM_CLOSE_ERROR, 

/* Release memory */ 
DSM_Close (DC_pCBData) ; 
DosFreeMem{pDC__sExtMsg) ; 
DosFreeMem (pDC_sRcvdMsg) ; 

DBCRDT_Display ( "DBCRDT_Stop : Debit/Credit Comms Stopped ! \r\n" ) ; 
return; 
} /* DBCRDT_Stop */ 



* Function: Debit /Credit Send Message to Host 

* Desc: Send a message to the host Debit/Credit processor. 

* Inputs: PUCHAR pszMsg - Pointer to messge to transmit. 

* MACKEUCO or MACKEC03 from Receive thread, 

* MACKEUC2, EUC1, EUC3, EUC4, EUC5, or EUC6 from device 

* (EV/AVM), 

* EUB1, EUB3, EUB5,MACKEUC3, MACKEUC4 , or MACKEUC5 from 

* EV (TRANSIT AUTHORITY only) . 

* USHORT usMsgLength - Length of message data. 

* Outputs: N/A 

* Return Value: N/A 

* External Effects: N/A 

* Implementation: N/A 

BOOL DBCRDT_SendToHost (PUCHAR pszMsg, ULONG ulMsgLength, PUCHAR auchlnfo) 
{ 

APIRET rc; 

ULONG ulPriority; 

BOOL bRc; 

UCHAR szMsgType [MSG_ID_TYPE_MAX] ; 

PUCHAR pMsgPtr; 
#ifdef DEV SMADS 



rc, _FILE_ 

rc, FILE 

rc, FILE 

rc, FILE 

rc, FILE 

rc, FILE 



LINE ) ; 

LINE ) ; 

LINE ) ; 

LINE ) ; 

LINE ) ; 

LINE ) ; 



LONG IMsgFP; 

ULONG ulKey; 

UCHAR szBuffer [82] ; 

DSM_CBUF_HDR t Di s kMs gHdr ; 

DSM_MSG_STATE emRc ; 
iendif 



/* Place message on Debit /Credit transmit queue */ 
pMsgPtr - (PUCHAR) mailoc (ulMsgLength + DSM_INFO__SIZE) ; 
if (pMsgPtr == NULL) 
{ 

DBCRDT_Error (DBCRDT_MEMORY_ERROR, OUL, FILE , LINE ); 

return FALSE; 

} 

LIB_cnv_ebcdic_to_ascii (pszMsg, szMsgType, MSG_ID_TYPE_MAX) ; 

if ( ! strncmp (szMsgType, MSG_ID_EUC3, MSG_ID_TYPE_MAX) || 
! strncmp (szMsgType, MSG_ID_EUC4, M S G_ I D_T Y P E_M AX ) | | 
! strncmp (szMsgType, MSG_ID_EUC5, MSG_ID_TYPE_MAX) | | 
! strncmp (szMsgType, MSG_ID_EUB3, MSG_ID_TYPE_MAX) | | 
! strncmp (szMsgType, MSG_ID_EUB5, MSG_ID_TYPE_MAX) ) 

{ 

/* Place message in circular buffer file */ 

if (! DBCRDT_DSMAdd (pszMsg, ulMsgLength, auchlnfo) ) 

{ 

free (pMsgPtr ) ; 

return TRUE; /* Duplicate or buffer full */ 

} 

ulPriority = 0; 

} 

else /* EUCO, EUC1, EUC6, MACKEC03, MACKEUCO, or MACKEUC2 */ 
{ 

ulPriority = 15; 

} 

/* Put message on host send queue */ 

if (! strncmp (szMsgType, MSG_ID_MACK, MSG_ID_TYPE__MAX) ) /* MACK */ 
{ 

#ifdef DEV_SMADS 

/* For TRANSIT AUTHORITY, MACKS back to device are asynchronous, wait 
for */ 

/* confirmation of delivery before completion of message in the DSM */ 
LIB_cnv_ebcdic_to_ascii (pszMsg + MSG_ID_TYPE_MAX / szMsgType, 

MSG_ID_TYPE_MAX) ; 
if (! strncmp (szMsgType, MSG_ID_EUC3, MSG_ID_TYPE_MAX) || 
! strncmp (szMsgType, MSG_ID_EUC4, MSG_ID_TYPE_MAX) || 
! strncmp (szMsgType, MSG_ID_EUC5, MSG__ID_TYPE_MAX) || 
! strncmp (szMsgType, MSG_ID_EUB3, MSG_ID_TYPEjyiAX ) || 
! strncmp (szMsgType, MSG_ID_EUB5, MSG_IDJTYPE_MAX) ) 

{ 

ulKey = ( (MSG_C_MACK *) pszMsg ) ->cics_trans_no . v; 

emRc - DSM_SearchKey (DC_pCBData, ulKey, StDiskMsgHdr , SlMsgFP) ; 

if (emRc == DSM_MSG_OK) 

{ /* Found it, set message state in DSM to completed */ 
emRc - DSM_UpdateMsgState (DC_pCBData, IMsgFP, 

DSM_MSG_COMPLETED) ; 

if (emRc != DSM_MSG_OK) 
{ 



DBCRDT_Error ( DBCRDT_DSM_UPDATE_ERROR, emRc , 
FILE , LINE ) ; 

} 

} 

else 
{ 

sprintf (szBuf fer, "»»»DSM Search fail:Ox%x on key Ox%x\r\n", 

emRc, ulKey) ; 
DBCRDT_Display (szBuf fer) / 

} 

rc = OUL; 

1 

else 
{ 

#endif 

memcpy (pMsgPtr, pszMsg, ulMsgLength); 

rc = DosWriteQueue (DC_RecvQ, DC_MSG_SEND, ulMsgLength, 

pMsgPtr, ulPriority) ; 

#ifdef DEV_SMADS 
} 

tendif 
} 

else 
{ 

memcpy (pMsgPtr, auchlnfo, DSM_INFO_SIZE) ; /* Send addressing info */ 
memcpy (pMsgPtr + DSM_INFO_SIZE, pszMsg, ulMsgLength); 

rc = DosWriteQueue (DC_XmitQ, DC_MSG_SEND, ulMsgLength + DSM_INFO_SIZE, 

pMsgPtr, ulPriority) ; 

} 

if (rc) 
{ 

DBCRDT_Error (DBCRDT_QUEUE_WRITE_ERROR, rc, FILE , LINE ); 

free (pMsgPtr ) ; 
bRc = FALSE; 

} 

else 

bRc = TRUE; 

return bRc; 
} /* DBCRDT SendToHost */ 



* Function: Debit/Credit Verify Mack 

* Desc: Process the MACK from the AC. 

The end devices are only to recieve Positive Mack messages. 
It is the responsibility of the SC to attempt to resend 
the message to the AC. 

In attempting to resend, the SC will be sending the message 
as it was received from the End Device. 

The SC is relying on the low level protocols between it and 
the end devices to guarantee that the message received at 
the SC is the same as the message sent from the end device. 
The SC only sends MACKs received from the AC which have a 
zero for the Mack Status. 
! The end devices are commanded to resend any unacknowledged 
! message once per day. It is this manner which allows an end 



* ! device to give a message to the SC multiple times. 

* Inputs: Pointer to the received MACK Message buffer, it length, and 

* the mode it was received in. 

* Outputs: The MACK message is sent to the end device. 

* Return Value: Status of the MACK (see AC_MACK_STATUS in shapcOOO.h). 

* External Effects: N/A 

* Implementation: N/A 
******************************** 

static USHORT DBCRDT_Verif y_MACK (PVOID pvExtMsg, USHORT usExtMsgLen, 

MSG_C_HEADER *ptMsgHdr, PUCHAR auchlnfo, 
AC ACCOM MODE eMode) 



{ 



ULONG 
LONG 
USHORT 
UCHAR 

MSG_C_MACK 
DSM MSG STATE 



ulRc, ulDatimStamp; 
lMsgFP; 

usRc, usMackLen; 
szBuffer [82] ; 
sMackMsg; 
emRc / 



DSM__FILE_ERRORS efRc; 

if (usExtMsgLen > MSG_MAX_LENGTH ) 
return DC MACK ERROR; 



/* . Message to big, Nack It */ 



usMackLen = usExtMsgLen; 

ulRc = LIB_msg_rx_mack (pvExtMsg, &sMackMsg, &usMackLen) ; 
if (ulRc != LIB_SUCCESS) 
return DC_MACK_ERROR; 

/* Determine what to do next: 

/* 1 . OK - Return and send next message 

/* 2. RETRY - Resend message x times {see EC17) then abort 

/* 3. DELAY_XMIT - Disable Transmit and retry later 

/* 4. RESTART - Restart complete message, sequence #1 

/* 5. ABORT - Abort, do not resend this message 

switch (sMackMsg. status) 

{ 



V 
V 
V 
V 
*/ 
V 



case MSG_ACKSTS_OK: 

usRc = AC_MACK_OK; 
break; 

case MSG_ACKSTS_LENERR: 

usRc = AC_MACK_RETRY; 

break; 
case MSG_ACKSTS_BUSY: 

usRc - AC_MACK_DELAY_XMIT; 

DBCRDT_ACComs Disable ( ) ; 

break; 

case MSG_ACKSTS_PARAMINV: 
usRc = AC_MACK_RETRY; 
break; 

case MSG_ACKSTS_TRANSIDINV: 
usRc = AC_MACK_RETRY; 
break; 

case MSG_ACKSTS_TRANSREVINV: 
usRc = AC_MACK_RETRY; 
break; 

case MSG_ACKSTS_NOEXECUTE: 
usRc = AC MACK RETRY; 



/* Message received, processed OK */ 
/* Message length error, retry */ 



/* Received, cannot process, */ 
/* Disable transmit */ 



/* Invalid parameter data, retry */ 

/* Invalid transaction ID, retry */ 

/* Invalid revision level, retry */ 

/* Unable to execute command, retry */ 



break; 

case MS G__ACKSTS_RE START : /* Abort and re-start, retry */ 

usRc = AC_MACK_RETRY ; 
break; 

case MSG_ACKSTS_ABORT : /* Abort..., no retry */ 

usRc = AC_MACK_ABORT; 

break; 
default : 

usRc = AC_MACK_RETRY; 

break; 



/* If the mode is AC_XMIT_MODE and the MACK status is AC_MACK_OK */ 
/* then send the MACK to the end device. If the message is sent */ 
/* successfully then remove (complete) the message from the DSM. */ 
if (eMode == AC_XMIT_MODE) 

{ /* Message is MACK status zero and EUC4, EUC5, or EUC3 */ 
if ( (usRc == AC_MACK_OK) && 

( ! strncmp (sMackMsg. type, MSG_ID_EUC3, MSG_ID__TYPE_MAX) || 
! strncmp (sMackMsg. type, MSG_ID_EUC4, MSG_ID_TYPE_MAX) | | 
! strncmp (sMackMsg. type, MSG_ID_EUC5, MSG_ID_TYPE__MAX) | | 
! strncmp (sMackMsg. type, MSG_ID_EUB3, MSG_ID_TYPE_MAX) | | 
! strncmp (sMackMsg. type, MSG_ID_EUB5, MSG_I D JT Y PE_MAX) ) ) 
{ /* Complete EUC3, EUC4, EUC5, EUB3, or EUB5 message in DSM */ 
emRc == DSM_ChngMsgState (DC_pCBData, 

( (MSG_C_MACK *) pvExtMsg) ->cics_trans_no. v, 
DSM_MSG_COMPLETED) ; 

if (emRc != DSM_MSG_OK) 
{ 

DBCRDT_Error (DBCRDT_DSM_UPDATE_ERROR, emRc, 

FILE , LINE ) ; 

sprintf (szBuffer, RED_BACK "Tx MACK %4.4s, Can NOT change " 

"state to COMPLETED, Key=%08x, %08x . " BLACK_BACK "\r\n", 

sMackMsg . type, 

( (MSG_C_MACK *) pvExtMsg) ->cics_trans_no. v, 
sMackMsg . cics_trans_no . v) ; 
DBCRDT_Display (szBuffer) ; 

} 

else if ( ! DBCRDT_SendToDevice ( (PUCHAR) pvExtMsg, 

usExtMsgLen, auchlnfo) ) 
{ /* If MACK not sent to end device then store to send later */ 
ulDatimStamp = SHTIM_time ( ) ; 

efRc = DSM_MsgSave (DC_pCBData, (PUCHAR) pvExtMsg, 

DSM_MSG_NONPRIORITY, auchlnfo, 
( (MSG__C_MACK *) pvExtMsg) ->cics_trans_no.v, 
(SHORT) usExtMsgLen, ulDatimStamp, SlMsgFP) ; 
if (efRc != DSM_FILE_OK) 
{ 

DBCRDT_Error (DBCRDT_DSM_SAVE_ERROR, efRc, 
FILE , LINE ) ; 

} 

} 

} 

} 

ptMsgHdr = ptMsgHdr; 
return usRc; 

/* DBCRDT_Verify_MACK */ 



* Function: Debit /Credit Transmit Message 

* Desc: Transmit Debit/Credit message to host computer. 

* Inputs: N/A 

* Outputs: N/A 

* Return Value: N/A 

* External Effects: N/A 

* Implementation: N/A 

USHORT DBCRDT_ACTransmit (PUCHAR szExtMsg, USHORT usExtMsgLength) 
{ 

ULONG ulRc; 

USHORT usErr, usMack, usMackLen; 

USHORT usOrigMsgLength, usTransmitRecvLength ; 

BOOL bPolling; 

UCHAR szBuffer[82] , auchlnf o [DSM_INFO_SIZE] ; 

MSG_C_MACK sMackMsg; 

MSG_C_HEADER tMsgHdr ; 
#if FALSE 

DSM_MSG_STATE emRc ; 
#endif 

/* Display transmit message header */ 

ulRc = LIB_msg_get_header (SszExtMsg [DSM_INFO_SIZE] , &tMsgHdr) ; 

if (ulRc == LIB_SUCCESS) 

{ 

sprintf (szBuf fer, BROWN_BACK "Tx %4.4s Len Ox%x" BLACK_BACK "\r\n", 
tMsgHdr . type, usExtMsgLength} ; 

} 

else /* NOTE: No MACKs should go up the R-line */ 
{ 

tMsgHdr . type [0] = 0; 

usMackLen = usExtMsgLength - DSM_INFO_SI ZE; 

ulRc = LIB_msg_rx_mack(&szExtMsg[DSM_INFO_SIZE] , &sMackMsg, 

&usMackLen) ; 
if (ulRc == LIB__SUCCESS) 
{ 

sprintf (szBuf fer, BROWN_BACK "Tx MACK %4.4s Status %d" BLACK_BACK 
"\r\n", sMackMsg. type, sMackMsg . status } ; 

} 

else 
{ 

strcpy (szBuf f er, "DBCRDT_ACTransmit : Unknown message! ***\r\n"); 

} 

} 

DBCRDT_Display (szBuf f er ) ; 

/* End display transmit message header */ 

if ( DBCRDT_ACComs Disabled { ) && 

strncmp (SszExtMsg [DSM_INFO_SIZE] , MSG_ID_EUC0, MSG_ID_TYPE MAX)} 
{ /* If comms disabled and this is not an EUCO V - - 

usMack = AC_MACK_DELAY_XMIT; 

} 

else 
{ 



bPolling = FALSE; 

usOrigMsgLength = usExtMsgLength - DSM_INFO_SIZE ; 
memcpy (auchlnfo, szExtMsg, DSM_INFO_SIZE ) ; 

memcpy (pDC__sExtMsg, &s zExtMsg [ DSM_INFO_SI ZE] , usOrigMsgLength) ; 
usErr = SH_DCXmit (( PCHAR) pDC_sExtMsg, &usOrigMsgLength, 

( PCHAR) pDC_sRcvdMsg, &usTransmitRecvLength, 

bPolling) ; 

if ((usErr == AC_ERR0R_C0NTIN1UE ) || (usTransmitRecvLength == 0)) 
{ 

DC_eCommsStatus = DBCRDT_COMMS_DOWN; 

if (tMsgHcir .type [0] ) 

{ 

sprintf (szBuf fer, BLUE_BROWN "DBCRDT_ACTransmit : Send %4.4s " 
"FAILED. " WHITE_BLACK "\r\n", tMsgHdr . type ) ; 

} 

else 
{ 

sprintf (szBuf fer, BLUE_BROWN "DBCRDT_ACTransmit : Send MACK " 
n %4.4s FAILED. " WHITE_BLACK "\r\n", sMackMsg . type ) ; 

} 

DBCRDT_Display (szBuf fer) ; 
usMack = AC_MACK_ABORT; 

} 

else if (usErr == AC_ERROR_OK) 
{ 

usMack = DBCRDT_Verify_MACK(pDC_sRcvdMsg, usTransmitRecvLength, 

StMsgHdr, auchlnfo, AC_XMIT_MODE) ; 
if (usMack == AC_MACK_DELAY_XMIT) 

DBCRDT__ACComs Disable { ) ; 

else if (usMack == DC_MACK_ERROR) 

usMack = AC_MACK_ABORT; 

else 

{ /* If no AC error then DBCRDT_Verif y__MACK was called, and it */ 
/* changed the status of the message on Disk. If an error */ 
/* is encountered then the message status is not modified. */ 
DBCRDT_ACComsEnable ( ) ; /* If it was disabled, reenable it */ 

/* Display received message header */ 
usMackLen = usTransmitRecvLength; 

ulRc = LIB_msg_rx_mack( (PCHAR) pDC_sRcvdMsg, &sMackMsg, 

&usMackLen) ; 
if (ulRc == LIB_SUCCESS) 
{ 

sprintf (szBuf fer, 

BLUE_BROWN "Tx MACK %4.4s Status %d" WHITE_BLACK 
"\r\n", sMackMsg . type, sMackMsg . status ) ; 

} 

else 
{ 

strcpy (szBuf fer , 

" DBCRDT__ACTransmit : Unknown message rcvd ! ***\r\n"); 

} 

DBCRDT__Di splay (szBuf fer) ; 



/* End display received message header */ 

if ( ! strncmpfsMackMsg. type, MSG_ID_EUCO, MSG_IDJTYPE__MAX) ) 
{ 

DC_eCommsStatus = DBCRDT_COMMS_R_LINE_UP; 

} 

else 
{ 

DC_eCommsStatus = DBCRDT_COMMS_UP; 

} 

} 

} 

else /* Must be AC_ERROR_ABORT , AC_ERROR__RESET , or */ 
{ /* AC_ERROR_S HUT DOWN return from SH_DCXmit call */ 

DC_eCommsStatus - DBCRDT_COMMS_DOWN; 

if (tMsgHdr . type[0] ) 

{ 

sprintf (szBuf fer, BLUE_BROWN " DBCRDT_ACTransmit : SH_DCXmit " 
"%4.4s error, %d." WHITE_BLACK "\r\n", tMsgHdr . type, 
usErr) ; 

} 

else 
{ 

sprintf (szBuf fer, BLUE_BROWN "DBCRDT_ACTransmit : SH_DCXmit " 
"MACK %4.4s error, %d." WHITE_BLACK "\r\n", 
sMackMsg . type, usErr) ; 

} 

DBCRDT_Di splay ( s zBuf f er ) ; 
usMack = AC_MACK_ABORT; 

} 

} 

return usMack; 
} /* DBCRDT ACTransmit */ 



Function : 
Desc : 



Inputs : 
Outputs : 
Return Value: 
External Effects: 
Implementation : 



Debit/Credit Transmit Messages 

Remove Debit/Credit messages from transmit queue and 

transmit them to the host computer. This thread handles 

EUC1, EUC3, EUC4, EUC5, EUC6, MACKEUC1, MACKEUC3, MACKEUC4 

MACKEUC5, and MACKEUC6 messages only. 

N/A 

N/A 

N/A 

N/A 

N/A 



VOID ENV_CDECL DBCRDT_XmitMsgs (PVOID dummy) 
{ 

APIRET rc; 

ULONG ulExtMsgLength, ulMsgID; 

BOOL bRunning; 

UCHAR szExtMsg[MSG_MAX LENGTH]; 



/* Local Initialization */ 
bRunning = TRUE; 



/* Post 'Initialized' semaphore */ 



rc = DosPostEventSem (DC_InitSem) ; 

if (rc && (rc != ERROR_ALREADY_POSTED) ) 

{ 

DBCRDT_Error ( DBCRDT__SEM_POST_ERROR, rc, FILE , LINE ); 

bRunning = FALSE; 

} 

while (bRunning) 
{ 

if (DBCRDT_GetQueueMsg(DC_XmitQ, szExtMsg, SulExtMsgLength, &ulMsgID) ) 
{ 

if (ulMsgID == DC_MSG_EXIT) 

bRunning = FALSE; 
else if (ulExtMsgLength == OUL) 

DBCRDT_Error ( DBCRDT_QUEUE_EMPTY_MSG, rc, FILE , LINE ); 

else if (ulMsgID == DC_MSG_SEND) 

DBCRDT_ACTransmit {szExtMsg, (USHORT) ulExtMsgLength) ; 

else 

DBCRDT_Display ( "DBCRDT_XmitMsgs : Invalid queue message . \r\n" ) ; 

} 

else 
{ 

DosSleep (50L) ; /* Relinquish CPU cycles */ 

} 

} 

DC_iXmitMsgsId = -1; 

/* Post 'Closing 1 semaphore */ 

rc = DosPostEventSem (DC_XmitEndSem) ; 

if (rc && (rc != ERROR_ALREADY_POSTED) ) 

{ 

DBCRDT_Error (DBCRDT_SEM_POST_ERROR, rc, FILE , LINE ); 

} 

dummy = dummy; 
__endthread ( ) ; 
} /* DBCRDT_XmitMsgs */ 



Function : 

Desc : 

Inputs : 

Outputs : 

Return Value: 

External Effects: 

Implementation: 



Debit/Credit Manage DSM Messages 

Resend DSM messages that have not been sent yet. 

N/A 

N/A 

N/A 

N/A 

N/A 



VOID ENV_CDECL DBCRDT_ManageDSM ( PVOID dummy) 

{ 



APIRET rc; 

INT iLcv, iResend; 

ULONG ulCurTime, ulPriority, ulMsgsInQ; 

LONG IStartPtr, lMsgAdr; 

SHORT sLength; 

UCHAR szExtMsg [MSG_MAX_LENGTH] ; 

PUCHAR pMsgPtr; 

LONGINT tMsgType; 

DSM_CBUF_HDR tDiskMsgHdr; 

DSM_MSG_STATE eRc, emRc; 

/* Post 'Initialized' semaphore */ 

rc = DosPostEventSem (DC_InitSem) ; 

if {rc && (rc != ERROR_ALREADY_POSTED) ) 

{ 

DC_bRunning = FALSE; 

DBCRDT_Error (DBCRDT_SEM_POST_ERROR, rc, FILE , LINE ); 

} 

#ifdef DEVJSMADS 

iResend = DC_iSecondsForResend; /* Variable Seconds */ 

for (iLcv = 0; iLcv < 1800; iLcv++) 

{ /* Wait 15 minutes before starting */ 

DosSleep (500L) ; 

if (! DC_b Running) 

{ 

break; 

} 

} 

#else 

iResend = 900; /* 15 Minutes in 

seconds */ 
tendif 



while ( DC_bRunning) 
{ 

rc = DosQueryQueue (DC_XmitQ, &ulMsgsInQ) ; 

if (rc) 

{ 

DBCRDT_Error { DBCRDT_QUEUE_QUERY_ERROR / rc, FILE , LINE ); 

ulMsgsInQ = ULONG_b4AX; 

} 

ulCurTime = SHTIM_time ( ) ; 
IStartPtr = -1L; 

while (DC_bRunning && (ulMsgsInQ < 5UL) ) 

{ /* Check for unsent non-priority messages */ 

eRc = DSMjyfsgGetPtr (DC_pCBData, &tDiskMsgHdr , szExtMsg, &sLength, 

DSM_MSG_NONPRIORITY | DSM_MSG_SENT , &lMsgAdr, 
&lStartPtr) ; 
if (eRc == DSM_MSG_0K) 
{ 

if (tDiskMsgHdr . DatimStamp < ulCurTime - iResend) 
{ /* If more than specified age */ 

LIB_cnv_ebcdic_to_ascii (szExtMsg, tMsgType .b, 

MSG_ID_TYPE_MAX) ; 
if (! strncmp (tMsgType. b, MSG_ID_MACK, MSG_ID_TYPE_MAX) ) 
{ /* Send MACK EUC3, EUC4, or EUC5 to AVM */ 

if (DBCRDT_SendToDevice (szExtMsg, (USHORT) sLength, 



#ifdef DEV SMADS 



#endif 



#ifdef DEV SMADS 



#endif 



tDiskMsgHdr . uclnf o) ) 
/* If MACK sent to end device then delete MACK */ 
emRc = DSM_UpdateMsgState (DC_pCBData, IMsgAdr, 

DSM_MSG_COMPLETED) ; 

if (emRc != DSM_MSG_OK) 

DBCRDT_Error ( DBCRDT_DSM_UPDATE_ERROR, emRc, 
FILE , LINE ) ; 



} 



else 

{ /* For TRANSIT AUTHORITY, wait for device to act */ 
/* on last message before continuing */ 
DosSleep (2500L) ; 

} 

} 

else if { ( ! strncmp {tMsgType .b, MSG_ID_EUCO, 
MSG_ID_TYPE_MAX - 1)) 
I I 

( ! strncmp ( tMsgType . b , MSG_ID_EUB2 , 
MSG_ID_TYPE_MAX - 1) ) ) 
{ /* Send EUC3, EUC4 , or EUC5 to AC */ 
if ( ! DBCRDT_ACComs Di s abled ( ) ) 
{ 

pMsgPtr = (PUCHAR) malloc ( sLength + DSM_INFO_SIZE) ; 
if (pMsgPtr == NULL) 

DBCRDT_Error (DBCRDT_MEMORY_ERROR, OUL, 
FILE , LINE ) ; 

else 

{ /* Place message on D/C transmit queue */ 
ulPriority = 0 ; 

memcpy (pMsgPtr, tDiskMsgHdr . uclnf o, 

DSM_INFO_SIZE) ; 
memcpy (pMsgPtr + DSM_INFO_SIZE, szExtMsg, 

sLength) ; 

rc = DosWriteQueue (DC_XmitQ, DC_MSG__SEND, 

(ULONG) (sLength + 

DSM_INFO_SIZE) , 
pMsgPtr, ulPriority) ; 

if (rc) 
{ 

DBCRDT_Error ( DBCRDT_QUEUE_WRITE_ERROR, rc, 

FILE , LINE ) ; 

free (pMsgPtr ) ; 

} 

/* Wait one second to avoid filling up queue */ 
/* to fast. CC response is not too quick */ 
DosSleep(lOOOL) ; 

} 

} 

} 

else 
{ 

DBCRDT_Error (DBCRDT_DSM_MSG_ERROR, tMsgType. v, 
FILE , LINE ) ; 



} 

} 

else 

break; 

} 

ej.se 

break; 

} 

for (iLcv = 0; iLcv < 1800; iLcv+4-) 

{ /* Check every 15 minutes */ 

DosSleep(SOOL) ; 
if (! DC_b Running) 
break; 

} 

} 

DC_iManagDSMId = -1; 

/* Post 'Closing' semaphore */ 

rc = DosPostEventSem (DC_DSMEndSem) ; 

if (rc && (rc != ERROR_ALREADY_POSTED) ) 

{ 

DBCRDT_Error ( DBCRDT__SEM__POST_ERROR, rc, FILE , LINE ); 

} 

dummy = dummy; 
_endthread ( ) ; 
} /* DBCRDT_ManageDSM */ 



* Module: Get_LIB_Result 

* Desc: Examine the long returned by a call to table manager library 

* and return the approriate MACK status. 

* Inputs: lrc - Long integer to be examined. 

* Outputs: Status - Char field that is used for Mack Status. 

* Errors : None . 

I 

static UCHAR DBCRDT_GetLIBResult (ULONG ulRc) 
{ 

UCHAR ucStatus; 

if (ulRc == LIB_SUCCESS) 

ucStatus = MSG_ACKSTS_OK; 
else if (ulRc == LIB_W_MSG_INVVER) 

ucStatus = MS G_ACKS T S_T RAN S RE VI N V ; 
else if (ulRc == LIB_W_MSG_UNKNOWN | | ulRc == LIB_E_MSG_NULLPTR) 

ucStatus = MSG_ACKSTS_TRANSIDINV; 
else if (ulRc == LIB_E_MSG_INVLEN ) 

ucStatus = MSG_ACKSTS_LENERR; 

else 

ucStatus = MSG_AC KS T S_P ARAM I N V ; 
return ucStatus; 



* Module: ProcessEC03Msg 

* Desc: Message EC03 is the Delay Transmit Message. The DC_ACXmitSem 



* semaphore is set to the Disabled state if this command informs 

* us that communications with the AC Debit/Credit is disabled. 

* Inputs: EC03 Message. 

* Outputs: ACXmitSem 

* Errors: Default error handling. 

static UCHAR DBCRDT_ProcessEC03Msg (MSG_EC03 *psEC03Msg) 
{ 

UCHAR ucStatus, ucEC03Value; 

/* Get the new communications value */ 
ucEC03Value - psEC03Msg->f data . xmit_ctrl ; 
if ( (ucEC03Value != 0) && (ucEC03Value != 1)) 
ucStatus = MSG_ACKSTS_PARAMINV; 

else 

{ /* Store the new value in to Table Manger ER63 structure */ 
ucStatus - MSG_ACKSTS_OK; 
if (ucEC03Value == 1) 

DBCRDT_ACComs Disable ( ) ; 

} 

return ucStatus; 

} 



n 



APPENDIX C 



IDENTIFICATION DIVISION . 
PROGRAM- I D . CWRB7 100. 
AUTHOR. CUBIC/CARCG 
INSTALLATION. 

DATE-WRITTEN. JANUARY 2000. 
DATE-COMPILED. 

* * 



PROGRAM NAME 
PROGRAM ID: 
SYSTEM: 
PROJECT 

DESC: 



MONTHLY BENEFITS / CLAIMS ACTIVITY REPORT 
CWRB7100 

9121-490, MVS/XA, CICS, COBOL II, ORACLE 
ELECTRONIC BENEFITS DISTRIBUTION SYSTEM 



INPUTS: 

REFERENCE FILE 
BENEFITS TABLE 
CLAIMS TABLE 
DEFINITION TABLE 
CUSTOMER TABLE 
CARDHOLDER TABLE 



VSAM RANDOM ACCESS FILE 

ORACLE FILE # 

ORACLE FILE # 

ORACLE FILE # 

ORACLE FILE # 

ORACLE FILE # 



** 

* * 

* * * 
/ 

ENVIRONMENT DIVISION. 
CONFIGURATION SECTION. 
SPECIAL-NAMES. C01 IS TOP-OF-PAGE. 
SOURCE-COMPUTER. ES-9000. 
OBJECT-COMPUTER. ES-9000. 

INPUT-OUTPUT SECTION. 
FILE-CONTROL. 

* 



OUTPUTS: 

MONTHLY BENEFITS / CLAIMS ACTIVITY REPORT 

PROGRAM CALLS: 
NONE 

REVISION HISTORY / REMARKS 

01/00 SMB000 HYNSON INIT CODING 



* COPYLIB NAME 

* COPYLIB ID 



REFER SELECT /ASSIGN 
CWAL0300 



* SYSTEM: 9121-490, MVS/XA, CICS, COBOL II, VSAM 

* PROJECT: 170-2660, ELECTRONIC BENEFITS DISTRIBUTION SYSTEM 

* ON-LINE MONITORING AND CONTROL 
* 

* DESC: THIS COPYLIB CONTAINS THE SELECT/ASSIGN STATEMENT 

* FOR THE REFERENCE TABLE FILE. 



00000010 
00000020 
00000030 
00000040 
00000050 
00000060 
00000070 
00000080 
00000090 
00000091 
00000092 
00000093 
00000094 
00000095 
00000096 
00000097 
00000098 
00000099 
00000100 
00000110 
00000120 
00000130 
00000140 
00000150 
00000160 
00000170 
00000180 
00000190 
00000191 
00000192 
00000193 
00000194 
00000195 
00000196 
00000197 
* 00000198 
00000199 
00000200 
00000210 
00000220 
00000230 
00000240 
00000250 
00000260 
00000270 
**00000280 
*00000290 
*00000291 
*00000292 
*00000293 
*00000294 
*00000295 
*00000296 
*00000297 
*00000298 
*00000299 
*00000300 



******************************************************************QQQQQ3^Q 


* REVISION HISTORY: 


*00000320 




*00000330 


* 04/10/97 JLK INITIAL CODING 


*00000340 


******************************************************************qqqqq35q 




UUUUUobU 




000003 /0 


ORGANIZATION INDEXED 


00000380 


ACCESS IS DYNAMIC 


00000390 


RECORD KEY IS RF- PRIME-KEY 


00000391 


FILE STATUS IS RF-STATUS . 


00000392 




00000393 


SELECT RPT-FILE ASSIGN TO RPTFILE. 


■ 00000394 




00000395 


DATA DIVISION. 


00000396 


FILE SECTION. 


00000397 




00000398 


******************************************************************QQQQQ3gg 


* 


*00000400 


* COPYLIB NAME : REFER FILE DESCRIPTION 


*00000410 


* COPYLIB ID : CWDL0300 


*00000420 


* 


*00000430 


* SYSTEM: 9121-490, MVS/XA, CICS, COBOL II, VSAM 


*00000440 


* PROJECT: 170-2660, ELECTRONIC BENEFITS DISTRIBUTION SYSTEM 


*00000450 


* ON-LINE MONITORING AND CONTROL 


*00000460 


* 


*00000470 


* DESC: THIS COPYLIB CONTAINS THE FILE DESCRIPTION 


*00000480 


* FOR THE REFERENCE TABLE FILE. 


*00000490 




*00000491 


********************************** 


* REVISION HISTORY: 


*00000493 


* 


*00000494 


* 01/25/99 rdrk INITIAL CODING 


*00000495 


******************************************************************QQQQQ4gg 




00000497 


FD REFER-FILE. 


00000498 


01 RF-RECORD. 


00000499 


05 RF-PRIME-KEY PICX{17). 


00000500 


05 RF- DATA-ELEMENTS . 


00000510 


** START-EXPIRATION-DATE FORMAT YYYYMMDD 


00000520 


10 RF- START-EXPIRATION- DATE PIC X(08). 


00000530 


10 FILLER PIC X(01). 


00000540 


** END-EXPIRATION-DATE FORMAT YYYYMMDD 


00000550 


10 RF-END- EXPIRATION- DATE PIC X{08). 


00000560 


10 FILLER PIC X(39). 


00000570 


10 RF-ENTRY-STATUS PIC X(01). 


00000580 


88 RF-ENTRY-ACTIVE VALUE 'A'. 


00000590 


88 RF-ENTRY- INACTIVE VALUE T. 


00000591 


* 


00000592 


* 


00000593 


FD RPT-FILE 


00000594 


RECORDING MODE IS F. 


00000595 


01 RPT-REC PIC X(132) . 


00000596 


* 


00000597 


/ 


00000598 


WORKING-STORAGE SECTION. 


00000599 


01 FILLER PIC X(30) VALUE ' WORKING STORAGE STARTS HERE'. 


00000600 



if*************************************************** 

* * * * 

** SQLCODE PARAMETERS ** 

* * + * 
**************************************************** 

* * 

*************************************************************** 
* 

* COPYLIB NAME : ORACLE SQLCODES 

* COPYLIB ID : CWELB000 
* 

* SYSTEM: 9121-490 MVS/ESA, CICS, COBOL II, ORACLE 

* PROJECT: 170-2719 ELECTRONIC BENEFITS DISTRIBUTION SYSTEM 



* REVISION HISTORY : 

* 

* 01/05/00 SMB000 RONO INITIAL 
*************************************************************** s 

*********************************** 
01 ORACLE-SQL-CODES . 



00000610 
00000620 
00000630 
00000640 
00000650 
00000660 
00000670 
***00000680 
*00000690 
*00000691 
*00000692 
*00000693 
*00000694 
*00000695 

* *00000696 

******************************************************************QQQQQg^7 

^00000698 
^00000699 
^00000700 
r ***00000710 
'***00000720 
00000730 
00000740 
00000750 
00000760 
00000770 
00000780 
00000790 
00000791 
00000792 
00000793 
00000794 
00000795 
00000796 
00000797 
00000798 
00000799 
00000800 
00000810 
00000820 
00000830 
00000840 
00000850 
00000860 
00000870 
00000880 
00000890 
00000891 
00000892 

r**************************************************************QQQQQgg^ 

* 00000894 
-INC CWELB100 0000089% 

* 00000896 
EXEC SQL VAR 00000897 

BEN-LOAD-DT-TM IS DATE 00000898 

END-EXEC 00000899 

00000900 



/ 



01 



* * 

* * * * 

* * 

* * * * 

* * 

* * 

* * * * 
** 

* * 

* * * * 



05 


ORA-NAMED- SQLCODE 


PIC 


S9(8) COMP. 




88 ORA-SQL-SUCCESSFUL 




VALUE 0. 


8 


8 ORA- SQL- WARNING 


VALUE +001 THRU +9999. 




88 ORA-SQL-ROW-NOT-FOUND 




VALUE +1403, +100. 




88 ORA- SQL-END-OF- FETCH 




VALUE +1403, +100. 




8 8 ORA- SQL-GENERAL-ERROR 




VALUE -9999 THRU -001 




8 8 ORA-SQL-DUPLICATE-ROW 




VALUE -1. 




8 8 ORA-SQL-NOT-LOGGED-ON 




VALUE -1012. 




8 8 ORA- S QL - 1 NVAL ID- COLUMN 




VALUE -904 . 


05 


ORA-SQLCODE-DISP-4 


PIC 


-(4)9. 


05 


ORA-SQLCODE-DISP-8 


PIC 


-(8)9. 


05 


ORA-TABLE-ID 


PIC 


X(20) . 


05 


ORA-FUNCTION-ID 


PIC 


X(08) . 


PROGRAM-STATUSES . 






05 


RF-STATUS PIC 


X(02) 


VALUE SPACES. 



88 VALID-STATUS 



VALUE '00', '97' 



************************************************ 

HOST VARIABLE DEFINITIONS ** 
************************************************ 

EXEC SQL BEGIN DECLARE SECTION END-EXEC. 

************************************************ 
BENEFITS DATA DESCRIPTIONS ** 



EXEC SQL VAR 

BEN- EXP I RAT ION- DATE 
END-EXEC 



IS DATE 



EXEC SQL VAR 

BEN-LAST-CLAIM-DT-TM IS DATE 
END-EXEC 

EXEC SQL VAR 

BEN-LAST-REQUEST-DT-TM IS DATE 
END-EXEC 



EXEC SQL VAR 

BEN-HOLD-DT-TM 
END-EXEC 

EXEC SQL VAR 

BEN-UPDATE-DT-TM 
END-EXEC 

EXEC SQL VAR 

BEN-INITIAL-VAL-AMT 
END-EXEC 

EXEC SQL VAR 

BEN-REM-VAL-AMT 
END-EXEC 



IS DATE 



IS DATE 



IS DECIMAL (5, 2) 



IS DECIMAL (5, 2) 



EXEC SQL VAR 

BEN- LAST -CLAIM- VAL-AMT IS DECIMAL {5, 2) 
END-EXEC 



* * CLAIMS DATA DESCRIPTIONS * * 

-INC CWELB500 



EXEC SQL VAR 

CLM- EFFECTIVE -DATE 
END-EXEC 

EXEC SQL VAR 

CLM- EX PI RAT I ON- DATE 
END-EXEC 

EXEC SQL VAR 

CLM- CLAIM- VAL-AMT 
END-EXEC 



IS DATE 



IS DATE 



IS DECIMAL(5,2) 



/ 

** DEFINITIONS DATA DESCRIPTIONS ** 

01 DEFINITION- ROW . 

05 DEF-BENEFIT-DESC PIC X(60). 

05 DEF- BENEFIT-TYPE PICX(05). 



00000950 
00000960 
00000970 
00000980 
00000990 
00000991 
00000992 
00000993 
00000994 
00000995 
00000996 
00000997 
00000998 
00000999 
00001000 
00001010 
00001020 
00001030 
00001040 
00001050 
00001060 
00001070 
00001080 
00001090 
00001091 
00001092 
00001093 
00001094 
00001095 
00001096 
00001097 
00001098 
00001099 
00001100 
00001110 
*00001120 
0000113% 
00001140 
00001150 
00001160 
00001170 
00001180 
00001190 
00001191 
00001192 
00001193 
00001198 
00001199 
00001200 
00001210 
00001220 
00001230 
00001240 
00001250 
00001260 
00001270 
00001280 



* * 






00001290 








00001291 


**************************************************** 


00001292 


* ★ 




CUSTOMER DATA DESCRIPTIONS ** 


00001293 


* * 






00001294 


01 


CUSTOMER- ROW . 


00001295 




05 


CUST-CUSTOMER-NAME PIC X(50). 


00001296 




05 


CUST-STREET-ADDR1 PIC X(40). 


00001297 




05 


CUST-STREET-ADDR2 PIC X(40). 


00001298 




05 


CUST-CITY PIC X (15) . 


00001299 




05 


CUST-STATE PIC X (02) . 


00001300 




05 


CUST-ZIPCODE PIC X(05). 


00001310 


* * 






00001320 


* * 






00001330 


**************************************************** 


00001340 


* * 




CARDHOLDER DATA DESCRIPTIONS ** 


00001350 






* * 


00001360 


01 


CARDHOLDER-ROW. 


00001370 




05 


CRDH-LAST-NAME PIC X(15). 


00001380 




05 


CRDH- FIRST -NAME PIC X(15). 


00001390 


★ * 






00001391 


* * 






00001392 


* * 






00001393 


******** 


******************************************** 


00001394 


* * 




HOST VARIABLE DESCRIPTIONS ** 


00001395 


* * 




* * 


00001396 


01 


WS- 


HOST-SEARCH-VARIABLES VALUE SPACES. 


00001397 




05 


WS- START-EX PI RAT ION- DATE PIC X(09). 


00001398 




05 


WS -END-EXPIRATION- DATE PIC X(09). 


00001399 


* * 






00001400 




05 


WS-OLD-CUSTOMER-ID PIC X(14). 


00001410 




05 


WS -OLD- SERIAL-NUMBER PIC X(15). 


0000,1420 




05 


WS-OLD-MFG- SERIAL-NUMBER PIC X(ll). 


00001430 




05 


WS -CURRENT- DATE PIC X(14) . 


00001440 


/ 






00001450 


******** 


******************************************** 


00001460 


* * 




* * 


00001470 


* * 




BENEFITS TABLE DECLARATION ** 


00001480 


* * 




* * 


00001490 


**************************************************** 


00001491 


* * 






00001492 




EXEC SQL 


00001493 






DECLARE BENE CURSOR FOR 


00001494 






SELECT TO CHAR (EFFECTIVE DATE, 'MM/DD/YY'), 


00001495 






SERIAL NUM, 


00001496 






CUSTOMER_ID, 


00001497 






BENEFIT TYPE, 


00001498 






EX P I RAT I ON_DAT E , 


00001499 






MFG_SERIAL_NUM, 


00001500 






INITIAL_VAL_AMT 


00001510 






FROM MCHECK . BENEFITS 


00001520 






WHERE EXPIRATION_DATE >= : WS-START-EXPIRATION-DATE 


00001530 






AND EX P I RAT I ON_DATE <= : WS -END-EX PI RAT I ON- DATE 


00001540 






ORDER BY 


00001550 






CUSTOMER ID, 


00001560 






SERIAL_NUM, 


00001570 






EXPIRATION DATE, 


00001580 





EFFECT I VE__DATE 


00001590 




END- EXEC. 


00001591 


/ 




00001592 


**************************************************** 


00001593 


* * 


* * 


00001594 




CLAIMS TABLE DECLARATION ** 


00001595 


* * 


* * 


00001596 


**************************************************** 


00001597 


* * 




00001598 




EXEC SQL 


00001599 




DECLARE CLMS CURSOR FOR 


00001600 




SELECT TO_CHAR( REQUEST JDTJTM, ' MM/DD/YY * ) , 


00001610 




EX P I RAT I ON_DAT E , 


00001620 




SERIAL_NUM, 


00001630 




MFG_SERIAL_NUM, 


00001640 




BENEFITJTYPE, 


00001650 




CLAIM VAL AMT 


00001660 




FROM MCHECK . CLAIMS 


00001670 




WHERE EXPIRATION_DATE >= : WS-START-EXPIRATION-DATE 


00001680 




AND EX P I RAT I ON_DAT E <= : WS-END-EXPIRATION-DATE 


00001690 




AND SERIAL_NUM = : WS-OLD-SERIAL-NUMBER 


00001691 




AND MFG SERIAL NUM = : WS-OLD-MFG-SERIAL-NUMBER 


00001692 




ORDER BY EXPIRATIONJDATE, 


00001693 




REQUEST DT TM 


00001694 




END-EXEC. 


00001695 


* 




00001696 




EXEC SQL END DECLARE SECTION END-EXEC. 


00001697 


/ 




00001698 


**************************************************** 


00001699 


* * 


* * 


00001700 


* * 


ORACLE SQL COMMUNICATION AREA ** 


00001710 


* * 


* * 


00001720 


********************** 


00001730 


* * 




00001740 




EXEC SQL INCLUDE SQLCA END-EXEC . 


00001750 






00001760 


01 


MSG-TEXT PIC X (200) . 


00001770 


01 


MAX-SIZE PIC S9(9) COMP VALUE 200. 


00001780 


01 


MSG-LENGTH PIC S9{9) COMP. 


00001790 


/ 




00001791 


**************************************************** 


00001792 


* * 


* * 


00001793 


* * 


REPORT DEFINITION AREA ** 


00001794 


* * 


* * 


00001795 


**************************************************** 


00001796 


* * 




00001797 


01 


HEADING-LINE 1 . 


00001798 




05 FILLER PIC X(10) VALUE ' RUN DATE: ' . 


00001799 




05 H L 1 - RE PORT - DAT E . 


00001800 




10 HL1-RD-MONTH PIC Z9 VALUE ZEROES. 


00001810 




10 FILLER PIC X VALUE '/'. 


00001820 




10 HL1-RD-DAY PIC Z9 VALUE ZEROES. 


00001830 




10 FILLER PIC X VALUE '/'. 


00001840 




10 HL1-RD-YEAR PIC X(04) VALUE SPACES. 


00001850 




05 FILLER PIC X(13) VALUE SPACES. 


00001860 




05 FILLER PIC X(23) 


00001870 




VALUE 'WASHINGTON METROPOLITAN 1 . 


00001880 



05 FILLER PIC X{23) 

VALUE ' AREA TRANSIT AUTHORITY ' . 

05 FILLER PIC X(30) VALUE SPACES 

05 FILLER PIC X(06) 

05 HL1- PAGE-NUMBER PIC ZZ9 



VALUE 'PAGE: 
VALUE ZEROES . 



01 HEADING-LINE1A. 
05 FILLER 
05 HL1- RUN -TIME 
05 FILLER 
05 FILLER 

VALUE ' BENEFITS 
05 FILLER 
05 FILLER 
05 HLl-PROGRAM-NME 

01 HEADING-LINE1B. 
05 FILLER 
05 FILLER 

VALUE 'EXPIRING 
05 HL1- START -DATE 
05 FILLER 
05 HL1 -END- DATE 



VALUE ' RUN TIME: 
VALUE SPACES. 
VALUE SPACES. 



PIC X(10) 
PIC X{08) 
PIC X{15) 
PIC X(46) 

/ CLAIMS ACTIVITY REPORT FOR BENEFITS' 
PIC X{29) VALUE SPACES. 
PIC X(06) VALUE ' PGM: ' . 
PIC X(08) VALUE SPACES. 



PIC X(37) 
PIC X(17) 
FROM 

PIC X(09) 
PIC X(04) 
PIC X{09) 



VALUE SPACES. 



VALUE SPACES. 
VALUE ' TO ' . 
VALUE SPACES. 



* CUSTOMER INFORMATION HEADINGS * 

01 HEADING-LINE2. 



05 FILLER 


PIC 


X(12) 


VALUE 


SPACES. 




05 FILLER 


PIC 


X(12) 


VALUE 


'CUSTOMER 


ID ' . 


05 HL2 -CUSTOMER- ID 


PIC 


X(14) 


VALUE 


SPACES. 




05 FILLER 


PIC 


X{04) 


VALUE 


SPACES. 




05 FILLER 


PIC 


X(15) 


VALUE 


'CUSTOMER 


INFO: 


05 HL2 -CUSTOMER-NAME 


PIC 


X(50) 


VALUE 


SPACES. 




HEADING-LINE 3 






VALUE 


SPACES. 




05 FILLER 


PIC 


X(57) . 








05 HL3-CUST-ADDR1 


PIC 


X(40) . 








HEADING- LINE 4 






VALUE 


SPACES. 




05 FILLER 


PIC 


X(57) . 








05 HL4-CUST-ADDR2 


PIC 


X (40) . 








HEADING-LINES. 












05 FILLER 


PIC 


X{57) 


VALUE 


SPACES. 




05 HL5 -CITY- STATE- ZIP 


PIC 


X(40) 


VALUE 


SPACES. 





* REPORT DETAIL INFORMATION * 



01 DETAIL-HEADING. 
05 FILLER 
05 FILLER 
05 FILLER 



PIC X{13) VALUE SPACES. 
PIC X(05) VALUE 'EVENT'. 
PIC X(28) VALUE SPACES. 



00001890 
00001891 
00001892 
00001893 
00001894 
00001895 
00001896 
00001897 
00001898 
00001899 
00001900 
00001910 
00001920 
00001930 
00001940 
00001950 
00001960 
00001970 
00001980 
00001990 
00001991 
00001992 
00001993 
00001994 
00001995 
00001996 
00001997 
00001998 
00001999 
00002000 
00002010 
00002020 
00002030 
00002040 
00002050 
00002060 
00002070 
00002080 
00002090 
00002091 
00002092 
00002093 
00002094 
00002095 
00002096 
00002097 
00002098 
00002099 
00002100 
00002110 
00002120 
00002130 
00002140 
00002150 
00002160 
00002170 
00002180 



05 


FILLER 


PIC 


X (04) 


VALUE 


' DATE ' . 


00002190 


05 


FILLER 


PIC 


X(ll) 


VALUE 


SPACES. 


00002191 


05 


FILLER 


PIC 


X(05) 


VALUE 


' VALUE ' . 


00002192 


05 


FILLER 


PIC 


X (09) 


VALUE 


SPACES. 


00002193 


05 


FILLER 


PIC 


X (04) 


VALUE 


*AUTH' . 


00002194 


05 


FILLER 


PIC 


X (08) 


VALUE 


SPACES. 


00002195 


05 


FILLER 


PIC 


X (07) 


VALUE 


'CLAIMED' . 


00002196 


05 


FILLER 


PIC 


X(05) 


VALUE 


SPACES. 


00002197 


05 


FILLER 


PIC 


X(09) 


VALUE 


' UNCLAIMED ' . 


00002198 
00002199 


DETAIL-LINE1 . 










00002200 


05 


FILLER 


PIC 


X (05) 


VALUE 


SPACES. 


00002210 


05 


FILLER 


PIC 


X(18) 






00002220 




VALUE 'CARDHOLDER NAME: 






00002230 


05 


DL1 -CARDHOLDER-NAME PIC X(30) 


VALUE 


SPACES. 


00002240 














00002250 


05 


FILLER 


PIC 


X(10) 


VALUE 


SPACES. 


00002260 


05 


FILLER 


PIC 


X(18) 






00002270 




VALUE 'CARD SERIAL 


#: 






00002280 


05 


DL2 -SERIAL-NUMBER 


PIC 


X(15) 


VALUE 


SPACES. 


00002290 
00002291 


DETAIL-LINE3 . 










00002292 


05 


FILLER 


PIC 


X(ll) 


VALUE 


SPACES. 


00002293 


05 


DL3-DETAIL-DESC 


PIC 


X (30) 


VALUE 


SPACES. 


00002294 


05 


FILLER 


PIC 


X(02) 


VALUE 


SPACES. 


00002295 


05 


DL3- DETAIL- DATE 


PIC 


X(10) 


VALUE 


SPACES. 


00002296 


05 


FILLER 


PIC 


X(04) 


VALUE 


SPACES. 


00002297 


05 


DL3- DETAIL- VALUE 


PIC 


-ZZ,ZZZ.99 VALUE ZEROES. 


00002298 














00002299 


TOTAL-BENES. 










00002300 


05 


FILLER 


PIC 


X(05) 


VALUE 


SPACES. 


00002310 


05 


FILLER 


PIC 


X(16) 


VALUE 


'TOTAL AUTHORIZED' . 


00002320 


05 


FILLER 


PIC 


X(49) 


VALUE 


SPACES. 


00002330 


05 


TB-TOTAL-AUTH 


PIC 


-ZZZ, ZZZ. 99 


VALUE ZEROES. 


00002340 














00002350 


TOTAL-CLAIMED. 










00002360 


05 


FILLER 


PIC 


X(05) 


VALUE 


SPACES . 


00002370 


05 


FILLER 


PIC 


X(16) 


VALUE 


' TOTAL CLAIMED 


00002380 


05 


FILLER 


PIC 


X(63) 


VALUE 


SPACES. 


00002390 


05 


TC -TOTAL-CLAIMED 


PIC 


-ZZZ, ZZZ. 99 


VALUE ZEROES. 


00002391 














00002392 


TOTAL-UNCLAIMED. 










00002393 


05 


FILLER 


PIC 


X(05) 


VALUE 


SPACES. 


00002394 


05 


FILLER 


PIC 


X(16) 


VALUE 


'TOTAL UNCLAIMED ' . 


00002395 


05 


FILLER 


PIC 


X(77) 


VALUE 


SPACES. 


00002396 


05 


TU- TOTAL- UNCLAIMED 


PIC 


-ZZZ, ZZZ. 99 


VALUE ZEROES. 


00002397 














00002398 


TOTAL-CUSTOMER. 










00002399 


05 


FILLER 


PIC 


X(03) 


VALUE 


SPACES. 


00002400 


05 


FILLER 


PIC 


X(24) 






00002410 




VALUE 'TOTALS FOR CUSTOMER 


ID: ' . 




00002420 


05 


TCUST-CUSTOMER-ID 


PIC 


X(14) 


VALUE 


SPACES. 


00002430 


05 


FILLER 


PIC 


X(27) 


VALUE 


SPACES. 


00002440 


05 


TCUST-AUTH 


PIC 


-Z, ZZZ, 


ZZZ. 99 


> VALUE ZEROES. 


00002450 


05 


FILLER 


PIC 


X 


VALUE 


SPACES. 


00002460 


05 


TCUST-CLAIMED 


PIC 


-Z, ZZZ, 


ZZZ. 99 


> VALUE ZEROES. 


00002470 


05 


FILLER 


PIC 


X 


VALUE 


SPACES. 


00002480 



05 TCUST- UNCLAIMED PIC -Z, ZZZ , ZZZ . 99 VALUE ZEROES. 
** WORKING STORAGE VARIABLES & ACCUMULATORS ** 



01 WORKING- VARIABLES . 
05 WS-ABEND-PARM 
05 WS-ABEND-PGM 



01 



PIC S9(04) COMP VALUE 0. 
PIC X(08) VALUE SPACES . 



05 



05 



05 



WS-PRIME-KEY. 
10 WS-TABLE-ID 
10 WS-PGM 
10 FILLER 

WS -CURRENT- DATE-NUM. 
10 CDN-CCYY 
10 CDN-MM 
10 CDN-DD 
10 FILLER 
WS- DATE-HOLD 
10 FILLER 
DH-YY 
DH-MM 
DH-DD 



PIC 9(02) 
PIC X(08) 
PIC X(07) 



COMP VALUE 0026. 
VALUE 'CWRB7100' 
VALUE SPACES. 



10 
10 
10 
10 



PIC 9(04) VALUE ZEROES. 
PIC 99 VALUE ZEROES. 
PIC 99 VALUE ZEROES. 
PIC X(06) VALUE SPACES. 

VALUE SPACES. 

PIC XX. 
PIC XX. 
PIC XX. 
PIC XX. 



DH-DD-NUM REDEFINES DH-DD 

PIC 99. 

88 VALID-DAY-RANGE VALUE 01 THRU 31. 



05 



88 
88 



88 
88 



WS-MONTH 
8 8 M JAN 
88 MFEB 
MMAR 
MAPR 
MM AY 
MJUN 
MJUL 
MAUG 
88 MSEP 
8 8 MOCT 
88 MNOV 
88 MDEC 



ACCUMULATORS VALUE 
05 AC-TOTAL-DETAIL 
05 AC-TOTAL-AUTHORIZED 
05 AC- TOTAL-CLAIMED 
05 AC-TOTAL-UNCLAIMED 



PIC X(03) 



VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 
VALUE 



SPACES 

'JAN' 

'FEB' 

'MAR 1 

'APR' 

'MAY' 

1 JUN' 

1 JUL 1 

'AUG 1 

' SEP 1 

' OCT 1 

'NOV 

'DEC 



ZEROES. 
PIC S9(5)V99. 
PIC S9(6)V99. 
PIC S9(6)V99. 
PIC S9(6)V99. 



05 


AC- 


FINAL-AUTHORI ZED 


PIC 


S9(7)V99 


05 


AC- 


FINAL-CLAIMED 


PIC 


S9 (7) V99 


05 


AC- 


FINAL-UNCLAIMED 


PIC 


S9 (7) V99 


05 


AC- 


PAGE-COUNT 


PIC 


9(3) . 


05 


AC- 


LINE-COUNT 


PIC 


9(2) . 



01 



WS-SWITCHES 

05 WS-CUSTOMER-SW 



VALUE 'N' 
PIC X. 



00002490 
00002491 
00002492 
00002493 
00002494 
00002495 
00002496 
00002497 
00002498 
00002499 
00002500 
00002510 
00002520 
00002530 
00002540 
00002550 
00002560 
00002570 
00002580 
00002590 
00002591 
00002592 
00002593 
00002594 
00002595 
00002596 
00002597 
00002598 
00002599 
00002600 
00002610 
00002620 
00002630 
00002640 
00002650 
00002660 
00002670 
00002680 
00002690 
00002691 
00002692 
00002693 
00002694 
00002695 
00002696 
00002697 
00002698 
00002699 
00002700 
00002710 
00002720 
00002730 
00002740 
00002750 
00002760 
00002770 
00002780 



88 NO-MORE-CUSTOMERS VALUE ' 


'X' . 


00002790 


88 PROCESS-CUSTOMERS VALUE 1 


1 P' . 


00002791 


88 CUSTOMER- BREAK VALUE ' 


'B' . 


00002792 


05 WS-CLAIMS-SW PIC X. 




00002793 


88 EOF-CLAIMS VALUE 1 


' Y' . 


00002794 


05 WS-FETCH-SW PIC X. 




00002795 


8 8 FIRST-FETCH VALUE 1 


'F' . 


00002796 


8 8 SUBSEQUENT- FETCH VALUE 1 


'S' . 


00002797 


/ 




00002798 


PROCEDURE DIVISION . 




00002799 


A000-MAIN-PROCEDURE. 




00002800 


PERFORM B000-INITIALIZE 




00002810 


THRU B000-EXIT. 




00002820 






00002830 


PERFORM COOO-PROCESS-BENEFITS 




00002840 


THRU C00O-EXIT 




00002850 


UNTIL NO-MORE-CUSTOMERS . 




00002860 






00002870 


PERFORM P7 00-PRINT-TOTAL-CUSTOMER 




00002880 


THRU P700-EXIT. 




00002890 






00002891 


PERFORM EO0O-CLEAN-UP 




00002892 


THRU EO0O-EXIT. 




00002893 


A000-EXIT. 




00002894 


GO BACK. 




00002895 






00002896 


B000-INITIALIZE. 




00002897 






00002898 


OPEN INPUT REFER- FILE . 




00002899 






00002900 


IF VALID-STATUS 




00002910 


PERFORM VI 00 -READ-REFER- FILE 




00002920 


THRU V100-EXIT 




00002930 


ELSE 




00002940 


DISPLAY ERROR OPENING REFERENCE FILE 


* * * 1 


00002950 


' STATUS: ' RF-STATUS 




00002960 


GO TO Z9999-ABEND 




00002970 


END-IF. 




00002980 






00002990 


OPEN OUTPUT RPT-FILE. 




00002991 






00002992 


MOVE WS-PGM TO HLl-PROGRAM-NME . 




00002993 






00002994 






00002995 


INITIALIZE ACCUMULATORS. 




00002996 






00002997 


EXEC SQL 




00002998 


SELECT TO_CHAR (SYSDATE, ' YYYYMMDDHHMMSS ' ) 




00002999 


INTO : WS-CURRENT-DATE 




00003000 


FROM DUAL 




00003010 


END-EXEC . 




00003020 






00003030 






00003040 


MOVE WS-CURRENT-DATE TO WS -CURRENT- DATE-NUM. 




00003050 


STRING WS-CURRENT-DATE (9:2), » : ' , 




00003060 


WS-CURRENT-DATE (11 : 2) , T : ' , 




00003070 


WS-CURRENT-DATE (13:2) 




00003080 



DELIMITED BY SIZE 

INTO HL1-RUN-TIME 

MOVE CDN-CCYY TO HL1-RD-YEAR. 

MOVE CDN-MM TO HLl-RD-MONTH . 

MOVE CDN-DD TO HLl-RD-DAY . 

PERFORM V110-OPEN-BENEFITS 
THRU V110-EXIT. 

IF PROCESS-CUSTOMERS AND ORA-SQL-SUCCESSFUL 
PERFORM P100-PRINT-HEADER1 

THRU P100-EXIT 
PERFORM VI 15 -FETCH -BENE FIT 

THRU V115-EXIT 
IF NOT (NO-MORE -CUSTOMERS AND FIRST-FETCH) 
PERFORM P200 -PRINT- CUST- INFO 

THRU P200-EXIT 
PERFORM P300-PRINT-CARDHLDR-INFO 

THRU P300-EXIT 
SET SUBSEQUENT-FETCH TO TRUE 
END-IF 
END-IF. 
B000-EXIT. 
EXIT. 



C000-PROCESS-BENEFITS . 

IF NOT (BEN-CUSTOMER-ID - WS-OLD-CUSTOMER-I D ) 
PERFORM C100-PROCESS-CUSTOMER-BREAK 
THRU C100-EXIT 
END-IF. 

IF NOT (BEN-SERIAL-NUM = WS-OLD- SERIAL-NUMBER) 
PERFORM C2 0 0 - PROCESS -CARDHOLDER-BREAK 
THRU C200-EXIT 
END-IF. 

MOVE BEN-EFFECTIVE-DATE TO DL3-DETAIL-DATE . 
MOVE BEN-INITIAL-VAL-AMT TO AC-TOTAL-DETAIL. 
MOVE AC-TOTAL-DETAIL TO DL3-DETAIL-VALUE . 

MOVE BEN-BENEFIT-TYPE TO DEF-BENEFIT-TYPE . 

PERFORM C350-OBTAIN-DEFINITION 
THRU C350-EXIT 

MOVE DEF-BENEFIT-DESC TO DL3-DETAIL-DESC . 

ADD BEN-INITIAL-VAL-AMT TO AC-TOTAL-AUTHORIZED 

AC-FINAL-AUTHORIZED 

PERFORM P4 00- PRINT- DETAIL 
THRU P400-EXIT 

PERFORM VI 15- FETCH-BENEFIT 
THRU V115-EXIT. 

C00O-EXIT. 



00003090 
00003091 
00003092 
00003093 
00003094 
00003095 
00003096 
00003097 
00003098 
00003099 
00003100 
00003110 
00003120 
00003130 
00003140 
00003150 
00003160 
00003170 
00003180 
00003190 
00003191 
00003192 
00003193 
00003194 
00003195 
00003196 
00003197 
00003198 
00003199 
00003200 
00003210 
00003220 
00003230 
00003240 
00003250 
00003260 
00003270 
00003280 
00003290 
00003291 
00003292 
00003293 
00003294 
00003295 
00003296 
00003297 
00003298 
00003299 
00003300 
00003310 
00003320 
00003330 
00003340 
00003350 
00003360 
00003370 
00003380 



EXIT. 

C100-PROCESS-CUSTOMER-BREAK. 

DISPLAY ' C100-PROCESS-CUSTOMER-BREAK' 

SET CUSTOMER-BREAK TO TRUE 

PERFORM C2 00- PROCESS-CARDHOLDER- BREAK 

THRU C200-EXIT 
PERFORM P7 00- PRINT-TOTAL-CUSTOMER 

THRU P700-EXIT 
PERFORM P100-PRINT-HEADER1 

THRU P100-EXIT 



MOVE BEN-SERIAL-NUM 
MOVE BEN-CUSTOMER-ID 



TO WS-OLD-SERIAL-NUMBER. 
TO WS-OLD-CUSTOMER-ID. 



PERFORM P200-PRINT-CUST-INFO 

THRU P200-EXIT. 
PERFORM P300- PRINT -CARDHLDR- INFO 

THRU P300-EXIT. 
MOVE SPACES TO WS-CUSTOMER-SW . 
C100-EXIT. 
EXIT . 

C2 00- PROCESS -CARDHOLDER-BREAK. 

PERFORM P410-PRINT-TOTAL-BENES 

THRU P410-EXIT. 
PERFORM V2 10 -OPEN-CLAIMS 

THRU V210-EXIT. 



PERFORM UNTIL EOF-CLAIMS 

MOVE CLM-REQUEST-DT-TM 
MOVE CLM-CLAIM-VAL-AMT 
MOVE CLM- BENE FIT-TYPE 



TO DL3- DETAIL- DATE 
TO DL3- DETAIL- VALUE 
TO DEF-BENE FIT- TYPE 



PERFORM C350-OBTAIN-DEFINITION 
THRU C350-EXIT 



TO DL3-DETAIL-DESC 
TO AC-TOTAL-CLAIMED, 
AC- FINAL-CLAIMED 



MOVE DEF-BENE FIT-DESC 
ADD CLM-CLAIM-VAL-AMT 

PERFORM P4 00 -PRINT -DETAIL 
THRU P400-EXIT 

PERFORM V2 20 -FETCH -CLAIMS 
THRU V220-EXIT 
END-PERFORM. 

PERFORM V2 60 -CLOSE-CLAIMS 
THRU V260-EXIT. 

PERFORM P500- PRINT -TOTAL-CLAIMS 
THRU P500-EXIT. 



PERFORM P600- PRINT-TOTAL-UNCLAIMED 
THRU P600-EXIT. 

IF NOT (CUSTOMER-BREAK OR NO-MORE-CUSTOMERS) 



00003390 
00003391 
00003392 
00003393 
00003394 
00003395 
00003396 
00003397 
00003398 
00003399 
00003400 
00003410 
00003420 
00003430 
00003440 
00003450 
00003460 
00003470 
00003480 
00003490 
00003491 
00003492 
00003493 
00003494 
00003495 
00003496 
00003497 
00003498 
00003499 
00003500 
00003510 
00003520 
00003530 
00003540 
00003550 
00003560 
00003570 
00003580 
00003590 
00003591 
00003592 
00003593 
00003594 
00003595 
00003596 
00003597 
00003598 
00003599 
00003600 
00003610 
00003620 
00003630 
00003640 
00003650 
00003660 
00003670 
00003680 



PERFORM P300-PRINT-CARDHLDR-INFO 
THRU P300-EXIT 

END-IF. 

MOVE BEN- SERIAL- NUM TO WS-OLD- SERIAL-NUMBER . 

C200-EXIT. 
EXIT. 

C350-OBTAIN-DEFINITION. 

INITIALIZE DL3- DETAIL- DESC, 
DEF-BENEFIT-DESC . 

EXEC SQL 

SELECT BENEFIT_DESC 

INTO : DEF-BENEFIT-DESC 
FROM MCHECK . BENEFITS_DEFINITION 
WHERE BENEFIT TYPE = : DEF-BENEFIT-TYPE 



END-EXEC. 
MOVE SQLCODE 



TO ORA- NAMED- SQLCODE 



EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 

MOVE DEF-BENEFIT-DESC TO DL3- DETAIL- DESC 

WHEN ORA-SQL-ROW-NOT-FOUND 

INITIALIZE DEF-BENEFIT-DESC 
MOVE ' NO DESC AVAIL 1 

TO DEF-BENEFIT-DESC 

WHEN OTHER 

DISPLAY 

f * INVALID SELECT ON DEFINITIONS FILE 1 
GO TO Z9999-ABEND 

END-EVALUATE. 
C350-EXIT. 
EXIT. 

EOOO-CLEAN-UP. 

INITIALIZE RPT-REC 
WRITE RPT-REC. 

DISPLAY ■ ** EOJ 1 WS-PGM 
DISPLAY ' 
DISPLAY • **■ 

EXEC SQL 

CLOSE BENE 
END-EXEC. 
EXEC SQL 

CLOSE CLMS 
END-EXEC. 

CLOSE RPT-FILE, REFER-FILE. 
EOOO-EXIT. 
EXIT. 

P100-PRINT-HEADER1 . 



00003690 
00003691 
00003692 
00003693 
00003694 
00003695 
00003696 
00003697 
00003698 
00003699 
00003700 
00003710 
00003720 
00003730 
00003740 
00003750 
00003760 
00003770 
00003780 
00003790 
00003791 
00003792 
00003793 
00003794 
00003795 
00003796 
00003797 
00003798 
00003799 
00003800 
00003810 
00003820 
00003830 
00003840 
00003850 
00003860 
00003870 
00003880 
00003890 
00003891 
00003892 
00003893 
00003894 
00003895 
00003896 
00003897 
00003898 
00003899 
00003900 
00003910 
00003920 
00003930 
00003940 
00003950 
00003960 
00003970 
00003980 



ADD 1 TO AC-PAGE-COUNT. 

MOVE AC- PAGE-COUNT TO HL1-PAGE-NUMBER . 

MOVE WS-START-EXPI RAT ION- DATE TO HL1- START- DATE 

MOVE WS- END-EX PI RATION-DATE TO HL1-END-DATE . 

INITIALIZE RPT-REC, AC-LINE-COUNT 
WRITE RPT-REC AFTER ADVANCING TOP-OF-PAGE. 
WRITE RPT-REC FROM HEADING-LI NE1 
WRITE RPT-REC FROM HEADING-LI NE1 A 
WRITE RPT-REC FROM HEADING- LINE IB 
INITIALIZE RPT-REC. 
WRITE RPT-REC. 
ADD 5 TO AC -LINE-COUNT . 
P100-EXIT. 
EXIT. 

P2 00-PRINT-CUST-INFO. 

PERFORM P 9 00-CHECK- PAGE-BREAK. 

INITIALIZE HEADING-LINE2 , HEADING-LINE3 , CUSTOMER- ROW, 
HEADING-LINE 4 , HEADING- LINES . 



MOVE BEN-CUSTOMER-ID 



TO HL2- CUSTOMER- ID 

WS-OLD-CUSTOMER-ID. 



EXEC SQL 

SELECT CUSTOMER_NAME , 
STREET_ADDR1, 
STREET_ADDR2 , 
CITY, 
STATE, 
ZIPCODE 
INTO :CUST-CUSTOMER-NAME, 
: CUST- STREET- ADDR1 , 
: CUST- STREET- ADDR2 , 
:CUST-CITY, 
:CUST-STATE, 
:CUST-ZIPCODE 
FROM MCHECK . CUSTOMER 
WHERE CUSTOMER_ID 
END-EXEC. 



BEN-CUSTOMER-ID 



MOVE SQLCODE TO ORA-NAMED-SQLCODE 

EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 

CONTINUE 

WHEN ORA-SQL-ROW-NOT-FOUND 

INITIALIZE CUSTOMER-ROW 
MOVE ' NO CUST INFO AVAIL ' 
TO CUST-CUSTOMER-NAME 

WHEN OTHER 

DISPLAY 

' * INVALID SELECT ON CUSTOMER FILE * 
GO TO Z9999-ABEND 

END-EVALUATE. 



00003990 
00003991 
00003992 
00003993 
00003994 
00003995 
00003996 
00003997 
00003998 
00003999 
00004000 
00004010 
00004020 
00004030 
00004040 
00004050 
00004060 
00004070 
00004080 
00004090 
00004091 
00004092 
00004093 
00004094 
00004095 
00004096 
00004097 
00004098 
00004099 
00004100 
00004110 
00004120 
00004130 
00004140 
00004150 
00004160 
00004170 
00004180 
00004190 
00004191 
00004192 
00004193 
00004194 
00004195 
00004196 
00004197 
00004198 
00004199 
00004200 
00004210 
00004220 
00004230 
00004240 
00004250 
00004260 
00004270 
00004280 



MOVE CUST-CUSTOMER-NAME TO HL2-CUSTOMER-NAME . 
INITIALIZE RPT-REC. 
WRITE RPT-REC. 

WRITE RPT-REC FROM HEADING-LINE2 
ADD 2 TO AC-LINE-COUNT. 

IF ORA-SQL-SUCCESSFUL 

INITIALIZE RPT-REC, HL3-CUST-ADDR1 
MOVE CUST- STREET -ADDR1 TO HL3-CUST-ADDR1 
WRITE RPT-REC FROM HEADING- L I NE3 
ADD 1 TO AC- LINE -COUNT 

IF CUST- STREET- ADDR2 > SPACES 

INITIALIZE RPT-REC, HL4 -CUST-ADDR2 
MOVE CUST- STREET -ADDR2 TO HL4 -CUST-ADDR2 
WRITE RPT-REC FROM HEADING- LINE 4 
ADD 1 TO AC-LINE-COUNT 

END- IF 

INITIALIZE RPT-REC, HL5-CITY-STATE-ZI P 
STRING CUST-CITY 1 , 1 CUST-STATE 1 1 CUST-ZIPCODE 
DELIMITED BY SIZE 
INTO HL 5 -CITY- STATE-ZIP 
WRITE RPT-REC FROM HEADING-LINE 5 
ADD 1 TO AC-LINE- COUNT 
END-IF 

INITIALIZE RPT-REC 
WRITE RPT-REC. 

WRITE RPT-REC FROM DETAIL-HEADING 
ADD 2 TO AC-LINE-COUNT. 
P200-EXIT. 
EXIT. 

P300-PRINT-CARDHLDR-INFO . 

PERFORM P900 -CHECK- PAGE- BREAK. 

MOVE BEN-SERIAL-NUM TO WS -OLD- SERIAL- NUMBER, 

DL2- SERIAL-NUMBER . 
MOVE BEN-MFG-SERIAL-NUM TO WS-OLD-MFG-SERIAL-NUMBER . 

INITIALIZE DL1 -CARDHOLDER-NAME. 

EXEC SQL 

SELECT LAST_NAME, 
FIRST_NAME 
INTO : CRDH- LAST -NAME, 
: CRDH-FIRST-NAME 
FROM MCHECK. CARDHOLDER 
WHERE SERIAL_NUM = : BEN-SERIAL-NUM 
END-EXEC . 



MOVE SQLCODE TO ORA-NAMED-SQLCODE . 

EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 

STRING CRDH -LAST-NAME, ' , ' 
DELIMITED BY SIZE 



CRDH-FIRST-NAME 



00004290 
00004291 
00004292 
00004293 
00004294 
00004295 
00004296 
00004297 
00004298 
00004299 
00004300 
00004310 
00004320 
00004330 
00004340 
00004350 
00004360 
00004370 
00004380 
00004390 
00004391 
00004392 
00004393 
00004394 
00004395 
00004396 
00004397 
00004398 
00004399 
00004400 
00004410 
00004420 
00004430 
00004440 
00004450 
00004460 
00004470 
00004480 
00004490 
00004491 
00004492 
00004493 
00004494 
00004495 
00004496 
00004497 
00004498 
00004499 
00004500 
00004510 
00004520 
00004530 
00004540 
00004550 
00004560 
00004570 
00004580 



INTO DL1 -CARDHOLDER-NAME 

WHEN ORA-SQL-ROW-NOT-FOUND 

MOVE ' ** NO CARDHOLDER NAME AVAIL **' 
TO DL1 -CARDHOLDER- NAME 

WHEN OTHER 

DISPLAY 

■ * INVALID SELECT ON CARDHOLDER FILE ' 
SQLCODE: 1 ORA-NAMED-SQLCODE 
GO TO Z9 999-ABEND 

END-EVALUATE . 

INITIALIZE RPT-REC . 
WRITE RPT-REC 

WRITE RPT-REC FROM DETAIL-LINE1 
ADD 2 TO AC-LINE-COUNT. 
P300-EXIT. 
EXIT. 

P400-PRINT-DETAIL. 

PERFORM P 900 -CHECK- PAGE-BREAK . 
INITIALIZE RPT-REC 

WRITE RPT-REC FROM DETAIL-LINE3 . 
ADD 1 TO AC-LINE-COUNT. 
P400-EXIT. 
EXIT. 

P4 10-PRINT-TOTAL-BENES . 

PERFORM P900-CHECK- PAGE-BREAK. 

MOVE AC-TOTAL-AUTHORIZED TO TB-TOTAL-AUTH . 

INITIALIZE RPT-REC 
WRITE RPT-REC FROM TOTAL-BENES . 
ADD 1 TO AC-LINE-COUNT. 
P410-EXIT. 
EXIT. 

P5 00- PRINT-TOTAL-CLAIMS . 

PERFORM P900-CHECK- PAGE-BREAK. 

MOVE AC-TOTAL-CLAIMED TO TC- TOTAL-CLAIMED. 

INITIALIZE RPT-REC 

WRITE RPT-REC FROM TOTAL-CLAIMED. 
ADD 1 TO AC-LINE-COUNT. 
P500-EXIT. 
EXIT. 

P600- PRINT-TOTAL-UNCLAIMED. 

PERFORM P900-CHECK-PAGE-BREAK. 

SUBTRACT AC-TOTAL-CLAIMED FROM AC-TOTAL-AUTHORIZED 

GIVING AC-TOTAL-UNCLAIMED 
ADD AC-TOTAL-UNCLAIMED TO AC-FINAL-UNCLAIMED. 

MOVE AC- TOTAL- UNCLAIMED TO TU-TOTAL-UNCLAIMED . 

INITIALIZE RPT-REC 

WRITE RPT-REC FROM TOTAL-UNCLAIMED. 
ADD 1 TO AC-LINE-COUNT. 

INITIALIZE AC-TOTAL-AUTHORIZED, 



00004590 
00004591 
00004592 
00004593 
00004594 
00004595 
00004596 
00004597 
00004598 
00004599 
00004600 
00004610 
00004620 
00004630 
00004640 
00004650 
00004660 
00004670 
00004680 
00004690 
00004691 
00004692 
00004693 
00004694 
00004695 
00004696 
00004697 
00004698 
00004699 
00004700 
00004710 
00004720 
00004730 
00004740 
00004750 
00004760 
00004770 
00004780 
00004790 
00004791 
00004792 
00004793 
00004794 
00004795 
00004796 
00004797 
00004798 
00004799 
00004800 
00004810 
00004820 
00004830 
00004840 
00004850 
00004860 
00004870 
00004880 



AC-TOTAL-CLAIMED, 
AC-TOTAL-UNCLAIMED . 



P600-EXIT. 
EXIT . 



P700- PRINT-TOTAL-CUSTOMER. 

PERFORM P 900 -CHECK- PAGE- BREAK . 

MOVE AC- FINAL- AUTHORIZED TO TCUST-AUTH 

MOVE AC-FINAL-CLAIMED TO TCUST-CLAIMED 

MOVE AC- FINAL-UNCLAIMED TO TCUST-UNCLAIMED 

MOVE HL2- CUSTOMER- ID TO TCUST-CUSTOMER-ID 

INITIALIZE RPT-REC 
WRITE RPT-REC 

WRITE RPT-REC FROM TOTAL-CUSTOMER 
ADD 2 TO AC- LINE- COUNT 

INITIALIZE AC-FINAL-AUTHORIZED, 
AC-FINAL-CLAIMED, 
AC- FINAL-UNCLAIMED. 

P700-EXIT. 
EXIT. 

P900-CHECK- PAGE-BREAK. 

IF AC-LINE- COUNT > 61 

PERFORM P100-PRINT-HEADER1 

THRU P100-EXIT 
INITIALIZE RPT-REC 
WRITE RPT-REC 

WRITE RPT-REC FROM DETAIL-HEADING 
INITIALIZE RPT-REC 
WRITE RPT-REC 
ADD 3 TO AC-LINE-COUNT 
END-IF. 
P900-EXIT. 

VI 00 -READ-REFER- FILE . 

MOVE WS-PRIME-KEY TO RF-PRIME-KEY 

READ REFER- FILE 

KEY IS RF-PRIME-KEY. 



TO WS- DATE -HOLD 



IF VALID-STATUS 

MOVE RF- START- EXPIRATION -DATE 
PERFORM VI 05 -EDIT- INPUT- DATES 

THRU V105-EXIT 
STRING DH-DD WS-MONTH '-' DH-YY 

DELIMITED BY SIZE 
INTO WS- START-EXPIRATION- DATE 

MOVE RF- END-EXPIRATION- DATE TO WS-DATE-HOLD 
PERFORM VI 05-EDIT- INPUT- DATES 

THRU V105-EXIT 
STRING DH-DD * -' WS-MONTH ' -' DH-YY 
DELIMITED BY SIZE 
INTO WS-END-EXPI RATION- DATE 



00004890 
00004891 
00004892 
00004893 
00004894 
00004895 
00004896 
00004897 
00004898 
00004899 
00004900 
00004910 
00004920 
00004930 
00004940 
00004950 
00004960 
00004970 
00004980 
00004990 
00004991 
00004992 
00004993 
00004994 
00004995 
00004996 
00004997 
00004998 
00004999 
00005000 
00005010 
00005020 
00005030 
00005040 
00005050 
00005060 
00005070 
00005080 
00005090 
00005091 
00005092 
00005093 
00005094 
00005095 
00005096 
00005097 
00005098 
00005099 
00005100 
00005110 
00005120 
00005130 
00005140 
00005150 
00005160 
00005170 
00005180 



ELSE 

DISPLAY • *** ERROR READING REFERENCE FILE 
* STATUS: ' RF-STATUS 
1 RF- PRIME- KEY : ' RF- PRIME- KEY 
' WS-PRIME-KEY: ' WS-PRIME-KEY 
GO TO Z9999-ABEND 
END-IF. 
V100-EXIT. 
EXIT . 



VI 05 -EDIT- INPUT- DATES . 
IF DH-DD IS NUMERIC 

IF NOT VALID-DAY-RANGE 
DISPLAY 

'*** ERROR PROCESSING INPUT DATE PARMS ***' 
' INVALID DAY SPECIFIED ' 

GO TO Z9999-ABEND 

END-IF 
END-IF. 

IF DH-YY IS NOT NUMERIC 
DISPLAY 

ERROR PROCESSING INPUT DATE PARMS 
' INVALID YEAR SPECIFIED ' 

GO TO Z9999-ABEND 

END-IF. 

EVALUATE DH-MM 



WHEN 


'01' 


SET 


MJAN 


TO 


TRUE 


WHEN 


' 02' 


SET 


MFEB 


TO 


TRUE 


WHEN 


'03' 


SET 


MMAR 


TO 


TRUE 


WHEN 


' 04 ' 


SET 


MAPR 


TO 


TRUE 


WHEN 


'05' 


SET 


MMAY 


TO 


TRUE 


WHEN 


'06' 


SET 


MJUN 


TO 


TRUE 


WHEN 


' 07 ' 


SET 


MJUL 


TO 


TRUE 


WHEN 


'08' 


SET 


MAUG 


TO 


TRUE 


WHEN 


'09' 


SET 


MSEP 


TO 


TRUE 


WHEN 


' 10' 


SET 


MOCT 


TO 


TRUE 


WHEN 


'11' 


SET 


MNOV 


TO 


TRUE 


WHEN 


' 12' 


SET 


MDEC 


TO 


TRUE 


WHEN 


OTHER 


DISPLAY 







'*** ERROR PROCESSING INPUT DATE PARMS *** ' 
' INVALID MONTH SPECIFIED ' 

GO TO Z999 9-ABEND 

END-EVALUATE. 
V105-EXIT. 
EXIT . 

V110-OPEN-BENEFITS . 
EXEC SQL 

OPEN BENE 
END-EXEC. 

MOVE SQLCODE TO ORA-NAMED-SQLCODE 

EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 

SET PROCESS-CUSTOMERS TO TRUE 
SET FIRST-FETCH TO TRUE 



00005190 
00005191 
00005192 
00005193 
00005194 
00005195 
00005196 
00005197 
00005198 
00005199 
00005200 
00005210 
00005220 
00005230 
00005240 
00005250 
00005260 
00005270 
00005280 
00005290 
00005291 
00005292 
00005293 
00005294 
00005295 
00005296 
00005297 
00005298 
00005299 
00005300 
00005310 
00005320 
00005330 
00005340 
00005350 
00005360 
00005370 
00005380 
00005390 
00005391 
00005392 
00005393 
00005394 
00005395 
00005396 
00005397 
00005398 
00005399 
00005400 
00005410 
00005420 
00005430 
00005440 
00005450 
00005460 
00005470 
00005480 



WHEN OTHER 

END-EVALUATE. 
V110-EXIT. 
EXIT. 

VI 15- FETCH-BENEFIT 
EXEC SQL 

FETCH BENE 
INTO 



DISPLAY 'BAD OPEN ON BENEFITS FILE' 
GO TO Z9999-ABEND 



BEN-EFFECTIVE-DATE, 
BEN-SERIAL-NUM, 
BEN-CUSTOMER-ID, 
BEN-BENEFIT-TYPE, 
BEN - EX P I RAT I ON- DAT E , 
BEN-MFG-SERIAL-NUM, 
BEN-INITIAL-VAL-AMT 



END-EXEC. 



MOVE SQLCODE TO ORA-NAMED-SQLCODE 

EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 

CONTINUE 

WHEN ORA-SQL-ROW-NOT- FOUND 

SET NO-MORE-CUSTOMERS TO TRUE 
IF FIRST-FETCH 
DISPLAY 

'NO CUSTOMER BENEFITS FOUND FOR PERIODS SPECIFIED' 
DISPLAY ' START DATE: 1 WS- START -EXP I RAT ION- DATE 
DISPLAY ' END DATE: ' WS-END-EXPIRATION-DATE 

INITIALIZE RPT-REC 
MOVE 

TO RPT-REC 
WRITE RPT-REC 

INITIALIZE RPT-REC 
MOVE 

» ** ** i 

TO RPT-REC 
WRITE RPT-REC 

INITIALIZE RPT-REC 
MOVE 

'** NO CUSTOMER BENEFITS FOUND FOR PERIODS SPECIFIED ** ' 
TO RPT-REC 
WRITE RPT-REC 

INITIALIZE RPT-REC 
STRING ' ** START DATE: ' WS - S TART -EX P I RAT I ON- DATE 

DELIMITED BY SIZE 
INTO RPT-REC 



00005490 
00005491 
00005492 
00005493 
00005494 
00005495 
00005496 
00005497 
00005498 
00005499 
00005500 
00005510 
00005520 
00005530 
00005540 
00005550 
00005560 
00005570 
00005580 
00005590 
00005591 
00005592 
00005593 
00005594 
00005595 
00005596 
00005597 
00005598 
00005599 
00005600 
00005610 
00005620 
00005630 
00005640 
00005650 
00005660 
00005670 
00005680 
00005690 
00005691 
00005692 
00005693 
00005694 
00005695 
00005696 
00005697 
00005698 
00005699 
00005700 
00005710 
00005720 
00005730 
00005740 
00005750 
00005760 
00005770 
00005780 



WS- END- EXP I RAT I ON- DATE 



WRITE RPT-REC 

INITIALIZE RPT-REC 

STRING ' ** END DATE: 

i 

DELIMITED BY SIZE 
INTO RPT-REC 
WRITE RPT-REC 

INITIALIZE RPT-REC 
MOVE 

TO RPT-REC 
WRITE RPT-REC 

INITIALIZE RPT-REC 
MOVE 

TO RPT-REC 
WRITE RPT-REC 
INITIALIZE RPT-REC 
WRITE RPT-REC 

ELSE 

PERFORM 

C2 00-PROCESS-CARDHOLDER-BREAK 
THRU C200-EXIT 

END-IF 



WHEN OTHER 



DISPLAY 

' * INVALID FETCH ON BENEFITS FILE ' 
GO TO Z9999-ABEND 

END-EVALUATE. 
V115-EXIT. 
EXIT. 

V2 10 -OPEN-CLAIMS . 

EXEC SQL 

OPEN CLMS 
END-EXEC. 

MOVE SQLCODE TO ORA-NAMED-SQLCODE 

EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 

MOVE 'N f TO WS-CLAIMS-SW 
PERFORM V2 2 0-FETCH -CLAIMS 

WHEN ORA-SQL-ROW-NOT-FOUND 

SET EOF-CLAIMS TO TRUE 

WHEN OTHER 

DISPLAY 1 INVALID OPEN ON CLAIMS FILE' 
GO TO Z9999-ABEND 

END-EVALUATE. 
V210-EXIT. 
EXIT. 



00005790 
00005791 
00005792 
00005793 
00005794 
00005795 
00005796 
00005797 
00005798 
00005799 
00005800 
00005810 
00005820 
00005830 
00005840 
00005850 
00005860 
00005870 
00005880 
00005890 
00005891 
00005892 
00005893 
00005894 
00005895 
00005896 
00005897 
00005898 
00005899 
00005900 
00005910 
00005920 
00005930 
00005940 
00005950 
00005960 
00005970 
00005980 
00005990 
00005991 
00005992 
00005993 
00005994 
00005995 
00005996 
00005997 
00005998 
00005999 
00006000 
00006010 
00006020 
00006030 
00006040 
00006050 
00006060 
00006070 
00006080 



V2 20 -FETCH-CLAIMS . 


0 
0 


EXEC SQL 




0 


FETCH CLMS 


0 


INTO 


CLM-REQUEST-DT-TM, 


0 




CLM- EX PI RAT I ON- DATE , 


0 




CLM-SERIAL-NUM, 


0 




CLM-MFG-SERIAL-NUM, 


0 




CLM- BENEFIT- TYPE, 


0 




CLM-CLAIM-VAL-AMT 


0 



END-EXEC. 
MOVE SQLCODE 



TO ORA-NAMED- SQLCODE 



EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 

CONTINUE 

WHEN ORA-SQL-ROW-NOT-FOUND 

SET EOF-CLAIMS TO TRUE 

WHEN OTHER 

DISPLAY 

■* INVALID FETCH ON CLAIMS FILE ' 
GO TO Z9999-ABEND 

END-EVALUATE . 
V220-EXIT. 
EXIT. 

V2 60 -CLOSE-CLAIMS . 
EXEC SQL 

CLOSE CLMS 
END-EXEC. 

MOVE SQLCODE TO ORA-NAMED-SQLCODE. 
IF ORA-SQL-SUCCESSFUL 
CONTINUE 

ELSE 

DISPLAY 'INVALID CLOSE ON CLAIMS FILE - SQLCODE: 

ORA-NAMED-SQLCODE SQLCODE 
GO TO Z9999-ABEND 
END-IF. 
V260-EXIT. 
EXIT. 

Z9999-ABEND. 

DISPLAY '***» 

DISPLAY ' ABENDING PROGRAM DUE TO PROCESSING ERRORS!!' 

DISPLAY 1 ABENDING SQLCODE: 1 SQLCODE 

1 ORA-NAMED-SQLCODE 
INITIALIZE MSG-TEXT. 

CALL 1 SQLGLM 1 USING MSG-TEXT, MAX-SI ZE, MSG-LENGTH. 
DISPLAY ' ABEND SQL MSG: 1 MSG-TEXT 
DISPLAY ' 1 



00006100 
00006110 
00006120 
00006130 
00006140 
00006150 
00006160 
00006170 
00006180 
00006190 
00006191 
00006192 
00006193 
00006194 
00006195 
00006196 
00006197 
00006198 
00006199 
00006200 
00006210 
00006220 
00006230 
00006240 
00006250 
00006260 
00006270 
00006280 
00006290 
00006291 
00006292 
00006293 
00006294 
00006295 
00006296 
00006297 
00006298 
00006299 
00006300 
00006310 
00006320 
00006330 
00006340 
00006350 
00006360 
00006370 
00006380 



INITIALIZE RPT-REC. 

STRING ' ABENDING PROGRAM ■ WS-PGM 
' DUE TO PROCESSING ERRORS! ! ' 
DELIMITED BY SIZE 
INTO RPT-REC 

WRITE RPT-REC . 



MOVE 999 TO WS-ABEND-PARM . 
DISPLAY WS-ABEND-PARM. 

PERFORM EOOO-CLEAN-UP 
THRU E00O-EXIT. 

MOVE ' ILBOABNO ' TO WS-ABEND-PGM . 
CALL WS-ABEND-PGM USING WS-ABEND-PARM 
99-EXIT. 
EXIT. 



00006390 
00006391 
00006392 
00006393 
00006394 
00006395 
00006396 
00006397 
00006398 
00006399 
00006400 
00006410 
00006420 
00006430 
00006440 
00006450 
00006460 
00006470 
00006480 



APPENDIX D 



r 



IDENTIFICATION DIVISION. 00000200 

PROGRAM-ID. CWRB7110. 00000400 

AUTHOR. CUBIC/CARCG. 00000500 

INSTALLATION . 00000600 

DATE-WRITTEN. FEBRUARY 2000. 00000700 

DATE-COMPILED. 00000800 

* *00001000 

* PROGRAM NAME: BENEFITS REPORT PGM *00001100 

* PROGRAM ID: CWRB7110 *00001200 

* *00001300 

* SYSTEM: 9121-490, MVS/XA, CICS, COBOL II, VSAM *00001400 

* PROJECT: 170-2719, ELECTRONIC BENEFITS DISTRIBUTION SYSTEM *00001500 

* BATCH REPORTS. *00001600 

* *00001700 

* DESC: THIS PROGRAM WILL SCAN THE BENEFITS TABLE FOR ROWS *00001800 

* LOADED WITHIN A SPECIFIED DATE RANGE. *00001900 

* THIS REPORT IS PRODUCED BY CUSTOMER ID FOR BILLING *00002000 

* BENEFITS TO THAT CUSTOMER. *00002100 

* *00002200 

* INPUTS: *00002300 

* REFERENCE FILE DEFMF03 *00002400 

* BENEFITS TABLE (ORACLE ) *00002500 

* CUSTOMER TABLE (ORACLE ) *00002600 

* *00002700 

* OUTPUTS: *00002800 

* A/R BENEFITS CUSTOMER BILLING REPORT *00002900 

* *00003000 

* ERRORS: *00003100 

* *00003200 

* REVISION HISTORY: *00003400 

* *00003500 

* *00003700 

* 12/22/99 SMB000 JXK INITIAL CODING *00003800 
* . *00003900 

/ 00004100 

ENVIRONMENT DIVISION. 00004200 

CONFIGURATION SECTION. 00004300 

SPECIAL-NAMES. C01 IS TOP-OF-PAGE. 00004400 

*******SOURCE-COMPUTER. ES-9000 WITH DEBUGGING MODE. 00004500 

SOURCE-COMPUTER. ES-9000. 00004 600 

OBJECT-COMPUTER. ES-9000. 00004700 

00004800 

INPUT-OUTPUT SECTION. 00004 900 

FILE-CONTROL. 00005000 

00005100 

SELECT PRINT-FILE ASSIGN TO DEFPR71 00005200 

FILE STATUS PRT-STATUS. 00005300 

00005400 

* REFER SELECT/ASSIGN 00005500 

COPY CWAL0300. 00005600 

/ 00005700 



DATA DIVISION. 






00005800 


FILE SECTION . 






00005900 
00006000 


FD PRINT-FILE 






00006100 


RECORDING MODE F. 






00006200 


01 PRT-RECORD . 






00006300 


05 PRT-LINE 


PIC X(133) . 


00006400 








00006500 


* REFER FILE DESCRIPTION 






00006600 


COPY CWDL0300. 






00006700 
00006800 


/ 






00006900 


WORKING- STORAGE SECTION . 






00007000 
00007100 


01 PROGRAM-VARIABLES . 






00007200 


05 FILLER 


PIC 


X(20) VALUE 


00007300 


'=>WORKING STORAGE* * * 1 . 






00007400 


05 WS-PROGRAM-ID 


PIC 


X ( 8 ) VALUE 


00007500 


'CWRB7110' . 






00007600 


05 WORK- PARA 


PIC 


X<8). 


00007700 
00007800 


01 RF-REFERENCE-RECORD. 






00007900 


COPY CWVL0300. 






00008000 


01 RF-REF-RDF REDEFINES RF-REFERENCE-RECORD. 


00008100 


05 FILLER 


PIC 


X{17) . 


00008200 


05 RF- FROM- DATE -X 1 4 


PIC 


X(14) . 


00008300 


05 FILLER 


PIC 


X. 


00008400 


05 RF-TO-DATE-X14 


PIC 


X(14) . 


00008500 


05 FILLER 


PIC 


X (28) . 


00008600 


* 






00008700 


0 1 REFER-STATUS-FLAGS . 






00008800 


COPY CWSL0300. 






00008900 


/ 






00009000 


01 RF-TABLE-ID-VALUES. 






00009100 


COPY CWWL0388. 






00009200 


* 






00009300 


01 INPUT-PARMS. 






00009400 


05 IP-LOAD-DATE-RANGE-SOURCE 


PIC 


X. 


00009500 


88 USE- REFER- FILE 


VALUE 1 R 1 . 




00009600 


8 8 USE-TODAYS-DATE 


VALUE ' T ' . 




00009700 


05 IP-FILLER1 


PIC 


X{39) . 


00009800 


/ 






00009900 


01 GENERAL-FIELDS. 






00010000 


05 WS-PGM-STATUS 


PIC X(01) 


VALUE 1 Y ' . 


00010100 


88 FIRST-TIME 


VALUE ' 


Y' . 


00010200 


88 NOT-FIRST-TIME 


VALUE 1 


N' . 


00010300 








00010400 


05 REPORT -FLAG 


PIC 9(01) VALUE 0. 


00010500 


88 PRT-NORM 


VALUE 0 




00010600 


88 PRT-CUST- BREAK 


VALUE 1 




00010700 


88 PRT- FINAL- TOTS 


VALUE 2 




00010800 


* 






00010900 


05 WS-PREV-CUST-ID 


PIC X(14) 




00011000 


05 WS - PREV- LOAD- DT - TM 


PIC X (7) . 




00011100 


05 WS -PREV- LOAD- DT-TM-X 14 


PIC X(14) 




00011200 


05 WS-BEN-LOAD- DT-TM-X 14 


PIC X(14) 




00011300 


05 WS- PREV- LOAD- DT-TM-X 17 . 






00011400 



05 
05 
05 
05 
05 
05 

05 



10 WS-PLD-MM 

10 FILLER 

10 WS-PLD-DD 

10 FILLER 

10 WS-PLD-YY 

10 FILLER 

10 WS-PLD-HH 

10 FILLER 

10 WS-PLD-MI 

10 FILLER 

10 WS-PLD-SS 

WS -BEN- LOAD- DT-CNT 
WS-BEN-CUST-TOT-CNT 
WS -BEN- REPORT- TOT -CNT 
WS -BEN- LOAD- DT-AMT 
WS-BEN-CUST-TOT-AMT 
WS-BEN-REPORT-TOT-AMT 



WS-FROM-DATE-X14 
WS-FR-CC 
WS-FR-YY 
WS-FR-MM 
WS-FR-DD 
WS-FR-HH 
WS-FR-MI 
WS-FR-SS 
05 WS-TO-DATE-X14 . 
10 WS-TO-CC 
WS-TO-YY 
WS-TO-MM 
WS-TO-DD 
WS-TO-HH 
WS-TO-MI 
WS-TO-SS 



10 
10 
10 
10 
10 
10 
10 



10 
10 
10 
10 
10 
10 



01 PROGRAM- FLAGS. 

05 WS-PRT-OPEN-FLAG 

88 WS-PRT-NOT-OPEN 
88 WS-PRT-OPEN 

05 PRT-STATUS 

8 8 PRT-SUCCESSFUL-IO 

i 

01 CWCB3000-PASS-AREA. 
COPY CWBL3000. 

01 COMMON- DEFINITIONS . 
COPY CWWL0020. 

i 

01 BINARY-CONVERSION-FIELDS . 
COPY CWWL9430. 

0 1 BATCH-RETURN-CODE . 
COPY CWWL94 50. 



PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 

PIC 
PIC 
PIC 
PIC 
PIC 
PIC 



PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 

PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 



99. 

X 

99. 

X 

99. 

X 

99. 

X 

99. 

X 

99. 



VALUE ' / ' 



VALUE 1 / ' . 



VALUE SPACE. 



VALUE 



VALUE 



VALUE +0. 
VALUE +0. 
VALUE +0. 
VALUE +0. 



S9(7) COMP 
S9(7) COMP 
S9(7) COMP 
S9(7)V99 COMP-3 
S9(7)V99 COMP-3 VALUE +0 
S9(7)V99 COMP-3 VALUE +0 



99. 
99. 
99. 
99. 
99. 
99. 
99. 

99. 
99. 
99. 
99. 
99. 
99. 
99. 



PIC 9(01) VALUE 0. 

VALUE 0. 
VALUE 1. 

PIC 9(02) . 

VALUE 0. 



/ 



01 WS - PROCES S -AREA . 



00011500 
00011600 
00011700 
00011800 
00011900 
00012000 
00012100 
00012200 
00012300 
00012400 
00012500 
00012600 
00012700 
00012800 
00012900 
00013000 
00013100 
00013200 
00013300 
00013400 
00013500 
00013600 
00013700 
00013800 
00013900 
00014000 
00014100 
00014200 
00014300 
00014400 
00014500 
00014600 
00014700 
00014800 
00014900 
00015000 
00015100 
00015200 
00015300 
00015400 
00015500 
00015600 
00015700 
00015800 
00015900 
00016000 
00016100 
00016200 
00016300 
00016400 
00016500 
00016600 
00016700 
00016800 
00016900 
00017000 
00017100 





COPY CWWL0080. 








00017200 


/ 












00017300 


**************************************************** 


00017400 


* * 




REPORT DEFINITION AREA 


* * 


00017500 


**************************************************** 


00017600 


* Sir 












00017700 


01 


PRINT-CONTROL- FLDS . 








00017800 




05 


PC-SPACES 






PIC X(133) VALUE SPACES . 


00017900 




05 


PC -MAX- PAGE- LINES 






PIC 99 VALUE 50. 


00018000 




05 


PC-LINE-CNT 






PIC 99 VALUE 99. 


00018100 




05 


PC-PAGE-NUM 






PIC 9(4) VALUE 1. 


00018200 




05 


PC-EOJ-FLAG 






PIC X VALUE 'N'. 


00018300 




88 


PC-EOJ 




VALUE ' Y 1 . 


00018400 




05 


PLEN 






PIC 999 VALUE ZERO. 


00018500 














00018600 


* * 












00018700 


01 


HEADING-LINE1. 








00018800 




05 


FILLER 


PIC 


X 


VALUE SPACES. 


00018900 




05 


FILLER 


PIC 


X(10) 


VALUE 'RUN DATE: ' . 


00019000 




05 


HL1-RE PORT-DATE . 








00019100 






10 HL1-RD-MM 


PIC 


99. 




00019200 






10 FILLER 


PIC 


X 


VALUE ' / ' . 


00019300 






10 HL1-RD-DD 


PIC 


99. 




00019400 






10 FILLER 


PIC 


X 


VALUE ' / ' . 


00019500 






10 HL1-RD-YY 


PIC 


99. 




00019600 




05 


FILLER 


PIC 


X (20) 


VALUE SPACES. 


00019700 




05 


FILLER 


PIC 


X (23) 




00019800 






VALUE 1 WASHINGTON METROPOLITAN'. 


00019900 




05 


FILLER 


PIC 


X (23) 




00020000 






VALUE ' AREA TRANSIT 


AUTHORITY' . 


00020100 




05 


FILLER 


PIC 


X{37) 


VALUE SPACES. 


00020200 




05 


FILLER 


PIC 


X(06) 


VALUE ' PAGE : ' . 


00020300 




05 


HL1- PAGE-NUMBER 


PIC 


ZZZ9 


VALUE ZEROES. 


00020400 


* * 












00020500 


01 


HEADING-LI NE2 . 








00020600 




05 


FILLER 


PIC 


X 


VALUE SPACES. 


00020700 




05 


FILLER 


PIC 


X(10) 


VALUE ' RUN TIME: 1 . 


00020800 




05 


HL2 -RUN-TIME . 








00020900 






10 HL2-RT-HH 


PIC 


99. 




00021000 






10 FILLER 


PIC 


X 


VALUE ' : ' . 


00021100 






10 HL2-RT-MI 


PIC 


99. 




00021200 






10 FILLER 


PIC 


X 


VALUE ' : ' . 


00021300 






10 HL2-RT-SS 


PIC 


99. 




00021400 




05 


FILLER 


PIC 


X(25) 


VALUE SPACES. 


00021500 




05 


FILLER 


PIC 


X(35) 




00021600 






VALUE 'ACCOUNTS 


RECEIVABLE 


SUMMARY REPORT' . 


00021700 




05 


FILLER 


PIC 


X(39) 


VALUE SPACES. 


00021800 




05 


FILLER 


PIC 


X(6) 


VALUE ' PGM: ' . 


00021900 




05 


HL2- PROGRAM- ID 


PIC 


X(8) . 




00022000 


* * 












00022100 


******* 


******************************************************* 


00022200 


* 




CUSTOMER INFORMATION 


HEADINGS * 


00022300 


* * * * * * * 


******************************* 


00022400 


* 












00022500 


01 


HEADING-LINE3. 








00022600 




05 


FILLER 




PIC X VALUE SPACES. 


00022700 




05 


FILLER 




PIC X(20) VALUE SPACES. 


00022800 



05 FILLER 



05 



HL3-FROM- 


•DATE. 






10 


HL3-FR- 


•MM 


PIC 


99 


10 


FILLER 




PIC 


X 


10 


HL3-FR- 


■DD 


PIC 


99 


10 


FILLER 




PIC 


X 


10 


HL3-FR- 


YY 


PIC 


99 


10 


FILLER 




PIC 


X 


10 


HL3-FR- 


■HH 


PIC 


99 


10 


FILLER 




PIC 


X 


10 


HL3-FR- 


■MI 


PIC 


99 


10 


FILLER 




PIC 


X 


10 


HL3-FR- 


■ss 


PIC 


99 



PIC X(17) 
VALUE 'LOAD DATES FROM: 



VALUE * / ' . 



VALUE ' / 1 



VALUE SPACE. 



VALUE 



VALUE 



05 FILLER 



05 



VALUE 



HL3-TO-DATE 


10 


HL3-TO- 


■MM 


10 


FILLER 




10 


HL3-TO- 


■DD 


10 


FILLER 




10 


HL3-TO- 


YY 


10 


FILLER 




10 


HL3-TO- 


HH 


10 


FILLER 




10 


HL3-TO- 


MI 


10 


FILLER 




10 


HL3-TO- 


SS 



PIC 


99 


PIC 


X 


PIC 


99 


PIC 


X 


PIC 


99 


PIC 


X 


PIC 


99 


PIC 


X 


PIC 


99 


PIC 


X 


PIC 


99 



PIC X(5) 
TO: 



VALUE ' / ' . 
VALUE 1 / 1 . 
VALUE SPACE. 
VALUE 1 : ' . 
VALUE ' : ' . 



PIC X(51) VALUE SPACES. 

r*********************************** 



05 FILLER 

***************************^ 

* COLUMN HEADINGS * 

************************************************************** 

* 

01 HEADING-LINE4 . 
05 FILLER 
05 FILLER 

BENEFITS LOAD DATES 
05 FILLER 

' # LOADED VALUE 
05 FILLER 



PIC X VALUE SPACES. 

PIC X(33) VALUE 



05 FILLER 



PIC X(33) VALUE 
i 

PIC X(33) VALUE 
i 

PIC X(33) VALUE 



************************************************************** 

* BANNER MESSAGES ■ * 

************************************************************** 

* 

01 BAN1-L1. 

05 FILLER 
05 FILLER 

I * * * ****** * * * * * •* St- -A- ******* * ** * * I 

05 FILLER PIC X(33) VALUE 

i *******************++*+**+***++** ( 

05 FILLER PIC X(33) VALUE 

i ********************************* i 

05 FILLER PIC X(33) VALUE 



PIC X VALUE SPACES. 

PIC X(33) VALUE 



00022900 
00023000 
00023100 
00023200 
00023300 
00023400 
00023500 
00023600 
00023700 
00023800 
00023900 
00024000 
00024100 
00024200 
00024300 
00024400 
00024500 
00024600 
00024700 
00024800 
00024900 
00025000 
00025100 
00025200 
00025300 
00025400 
00025500 
00025600 
00025700 
00025800 
00025900 
00026000 
00026100 
00026200 
00026300 
00026400 
00026500 
00026600 
00026700 
00026800 
00026900 
00027000 
00027100 
00027200 
00027300 
00027400 
00027500 
00027600 
00027700 
00027800 
00027900 
00028000 
00028100 
00028200 
00028300 
00028400 
00028500 



01 BAN1-L2. 

05 FILLER 
05 FILLER 

05 FILLER 

05 FILLER 

05 FILLER 
i 

01 BAN1-L3. 

05 FILLER 
05 FILLER 

05 FILLER 

'NO BENEFITS PROCESSED * * * 

05 FILLER 
t 

05 FILLER 



PIC X VALUE SPACES. 

PIC X(33) VALUE 

PIC X(33) VALUE 

PIC X(33) VALUE 

PIC X(33) VALUE 



PIC X VALUE SPACES . 

PIC X(33) VALUE 
+ * * i 

PIC X(33) VALUE 
i 

PIC X(33) VALUE 
i 

PIC X(33) VALUE 



* CUSTOMER DATA LINES * 



01 CUST-LINE1. 
05 FILLER 
05 CL-HEADER 
05 CL-DATA 
05 FILLER 

* REPORT DETAIL INFORMATION * 

01 DETAIL-LINE1 . 

VALUE SPACES. 



PIC X VALUE SPACES. 

PIC X(40) VALUE SPACES. 

PIC X(60) VALUE SPACES. 

PIC X(31) VALUE SPACES. 



05 


FILLER 


PIC 


X 


05 


FILLER 


PIC 


X(5) 


05 


DL1- LOAD- DATE 


PIC 


X(17 


05 


FILLER 


PIC 


X(8) 


05 


DL1-BEN-CNT 


PIC 


ZZZ, 


05 


FILLER 


PIC 


X(5) 


05 


DL1-BEN-AMT 


PIC 


z, zz 


05 


FILLER 


PIC 


X(77 



/ 

* ORACLE SQLCODE CHECK VARIABLES 
* 

01 ORA- SQLCODE- VARIABLES . 
COPY CWELB000. 

/ 

* ORACLE SQL DECLARATIVES BEGIN HERE | 

I 

V 



00028600 
00028700 
00028800 
00028900 
00029000 
00029100 
00029200 
00029300 
00029400 
00029500 
00029600 
00029700 
00029800 
00029900 
00030000 
00030100 
00030200 
00030300 
00030400 
00030500 
00030600 
00030700 
00030800 
00030900 
00031000 
00031100 
00031200 
00031300 
00031400 
00031500 
00031600 
00031700 
00031800 
00031900 
00032000 
00032100 
00032200 
00032300 
00032400 
00032500 
00032600 
00032700 
00032800 
00032900 
*00033000 
00033100 
00033200 
00033300 
00033400 
00033500 
00033600 
00033700 
*00033800 
*00033900 
*00034000 
*00034100 
*00034200 







00034300 




EXEC SQL BEGIN DECLARE SECTION END-EXEC. 


00034400 
00034500 


* 




00034600 


* 


BENEFITS TABLE DESCRIPTION 


00034700 


* 




00034800 


CWELB100 


0003490% 






00035000 




BENEFITS TABLE EQUIVALENCIES 


00035100 


* 




00035200 


CWELB101 


0003530% 


/ 




00035400 






00035500 


* 


CUSTOMER TABLE DESCRIPTION 


00035600 


* 




00035700 


CWELB300 


0003580% 


* 




00035900 


* 


CUSTOMER TABLE EQUIVALENCIES 


00036000 


* 




00036100 


CWELB301 


0003620% 






00036300 


01 


HOST-VARIABLES. 


00036400 




05 WS - FROM- DATE PIC X(7). 


00036500 




05 WS-TO-DATE PIC X(7). 


00036600 






00036700 




05 WS -PROCESS -DATE-X 14 PIC X(14). 


00036800 




05 WS-PD-X14 REDEFINES WS-PROCESS-DATE-X1 4 . 


00036900 




10 WS-PD-DATE. 


00037000 




15 WS-PD-CC PIC S99. 


00037100 




15 WS-PD-YY PIC S99. 


00037200 




15 WS-PD-MM PIC S99. 


00037300 




15 WS-PD-DD PIC S99. 


00037400 




10 WS-PD-TIME. 


00037500 




15 WS-PD-HH PIC S99. 


00037600 




15 WS-PD-MI PIC S99. 


00037700 




15 WS-PD-SS PIC S99. 


00037800 


* 




00037900 




EXEC SQL VAR 


00038000 




WS - FROM - DAT E IS DAT E 


00038100 




END-EXEC 


00038200 


* 




00038300 




EXEC SQL VAR 


00038400 




WS-TO-DATE IS DATE 


00038500 




END-EXEC 


00038600 


* 




00038700 




EXEC SQL END DECLARE SECTION END-EXEC 


00038800 


* 




00038900 


/ 




00039000 




EXEC SQL INCLUDE SQLCA 


00039100 




INCLUDE SQLCA 


00039200 




END-EXEC 


00039300 


* 




00039400 


* 




00039500 




BENEFITS CURSOR 


00039600 






00039700 




EXEC SQL DECLARE BENEFITS LOAD CURSOR FOR 


00039800 




SELECT 


00039900 



-INC CWELB800 

FROM MCHECK. BENEFITS 
WHERE LOAD_DT_TM >= 

AND LOAD_DT_TM <= 

ORDER BY CUSTOMER_ID, 
LOAD__DT__TM 

END-EXEC 

/ 

PROCEDURE DIVISION. 
A000-MAIN-ROUTINE. 
* DISPLAY 'A000: START' 

PERFORM BOOO-INITIALIZE THRU 
BOOO-INITIALIZE-EXIT 

IF BRC-IN-PROCESS 

PERFORM C000-PROCESS-CUSTOMER THRU 
COOO-PROCESS-CUSTOMER-EXIT 
UNTIL BRC-STOP- PROCESSING 
END-IF 

PERFORM EOOO-CLEAN-UP THRU 
EOOO-CLEAN-UP-EXIT 

AOOO-MAIN-ROUTINE-EXIT. 
GOBACK. 



: WS - FROM- DATE 
:WS-TO-DATE 



/ 



BOOO-INITIALIZE. 

DISPLAY 'BOOO: 



START ' 



SET BRC-IN-PROCESS 



TO 



TRUE 



' PRT-STATUS 



OPEN OUTPUT PRINT-FILE 

IF NOT PRT-SUCCESSFUL-IO 

DISPLAY 'ERROR OPENING PRINT-FILE 
SET BRC-OPEN-ERROR TO TRUE 
GO TO BOOO-INITIALIZE-EXIT 

END-IF 



REFER FILE HAS DATE RANGE PARMETERS UNTIL SOMETHING 
ELSE COMES ALONG 



ACCEPT INPUT-PARMS 
DISPLAY 'INPUT PARMS : 



INPUT-PARMS 



IF USE-TODAYS- DATE 

DISPLAY ' TODAYS DATE' 
PERFORM Bl 30 -GET- TODAYS -RANGE THRU 
Bl 30 -GET-TODAYS-RANGE-EXIT 

ELSE 

PERFORM Bl 50-GET-ENTERED-RANGE THRU 
Bl 50-GET-ENTERED-RANGE-EXIT 

END-IF 

EXEC SQL SELECT TO_CHAR (SYS DATE, ' YYYYMMDDHH24MISS ' ) 
INTO :WS-PROCESS-DATE-X14 
FROM DUAL 
END-EXEC 



0004000% 
00040100 
00040200 
00040300 
00040400 
00040500 
00040600 
00040700 
00040800 
00040900 
00041000 
00041100 
00041200 
00041300 
00041400 
00041500 
00041600 
00041700 
00041800 
00041900 
00042000 
00042100 
00042200 
00042300 
00042400 
00042500 
00042600 
00042700 
00042800 
00042900 
00043000 
00043100 
00043200 
00043300 
00043400 
00043500 
00043600 
00043700 
00043800 
00043900 
00044000 
00044100 
00044200 
00044300 
00044400 
00044500 
00044600 
00044700 
00044800 
00044900 
00045000 
00045100 
00045200 
00045300 
00045400 
00045500 
00045600 



DISPLAY 'PROCESS-DATE: ' WS-PROCESS-DATE-X14 






00045700 


* 












00045800 


MOVE 


PC-PAGE-NUM 


TO 


HL1- PAGE-NUMBER 




00045900 


MOVE 


WS-PD-MM 


TO 


HL1-RD-MM 






00046000 


MOVE 


WS-PD-DD 


TO 


HL1-RD-DD 






00046100 


MOVE 


WS-PD-YY 


TO 


HL1-RD-YY 






00046200 


MOVE 


WS-PD-HH 


TO 


HL2-RT-HH 






00046300 


MOVE 


WS-PD-MI 


TO 


HL2-RT-MI 






00046400 


MOVE 


WS-PD-SS 


TO 


HL2-RT-SS 






00046500 


MOVE 


WS- PROGRAM- ID 


TO 


HL2-PROGRAM- 


■ID 




00046600 


MOVE 


WS-FR-MM 


TO 


HL3-FR-MM 






00046700 


MOVE 


WS-FR-DD 


TO 


HL3-FR-DD 






00046800 


MOVE 


WS-FR-YY 


TO 


HL3-FR-YY 






00046900 


MOVE 


WS-FR-HH 


TO 


HL3-FR-HH 






00047000 


MOVE 


WS-FR-MI 


TO 


HL3-FR-MI 






00047100 


MOVE 


WS-FR-SS 


TO 


HL3-FR-SS 






00047200 


MOVE 


WS-TO-MM 


TO 


HL3-TO-MM 






00047300 


MOVE 


WS-TO-DD 


TO 


HL3-TO-DD 






00047400 


MOVE 


WS-TO-YY 


TO 


HL3-TO-YY 






00047500 


MOVE 


WS-TO-HH 


TO 


HL3-TO-HH 






00047600 


MOVE 


WS-TO-MI 


TO 


HL3-TO-MI 






00047700 


MOVE 


WS-TO-SS 


TO 


HL3-TO-SS 






00047800 














00047900 


* OPEN 


BENEFITS LOAD DATE RANGE CURSOR 








00048000 














00048100 


PERFORM V100-OPEN-BEN-LOAD THRU 










00048200 




V100-OPEN-BEN-LOAD-EXIT 










00048300 
00048400 


BOOO-INITIALIZE-EXIT. 










00048500 


EXIT 












00048600 


/ 












00048700 


B130-GET- 


-TODAYS -RANGE. 










00048800 


DI SPLAY 'B130: START ' 










00048900 














00049000 


MOVE 


, 0 t TO : 


BDT- 


■PROCESS-DIR 






00049100 


PERFORM D000-GMTCONV-PROCESS THRU 










00049200 




D000-GMTCONV-PROCESS-EXIT 










00049300 


IF BRC-STOP- PROCESSING 










00049400 


GO 


TO Bl 30 -GET-TODAYS-RANGE-EXIT 








00049500 


END-IF 










00049600 














00049700 


MOVE 


BDT-DATE TO 


WS- 

ws- 


FROM-DATE-X14 
■TO-DATE-X14 






00049800 
00049900 


MOVE 


ZEROES TO 


WS- 


•FROM- DATE-X 14 


(9 : 


6) 


00050000 


MOVE 


'235959' TO 


WS- 


TO-DATE-X14 


(9 : 


6) 


00050100 


DISPLAY ? TODAYS DATE RANGE FROM: 


1 


WS-FROM-DATE- 


X14 




00050200 




1 TO : ' 




WS-TO-DATE-X14 




00050300 














00050400 


MOVE 


WS - FROM- DATE-X 14 TO 


ws- 


DT-TM-X 






00050500 


PERFORM D180-DATE-X14-TO-ORA THRU 










00050600 




D18 0-DATE-X14-TO-ORA-EXIT 










00050700 


MOVE 


WS-ORA-DT-TM TO 


ws- 


FROM- DATE 






00050800 
00050900 


MOVE 


WS- TO- DATE-X 14 TO WS-DT 


'-TM-X 






00051000 


PERFORM D180-DATE-X14-TO-ORA THRU 










00051100 




D180-DATE-X14-TO-ORA-EXIT 










00051200 


MOVE 


WS-ORA-DT-TM TO 


ws- 


TO-DATE 






00051300 



Bl 30 -GET- TODAYS -RANGE-EX IT . 
EXIT . 

B150-GET-ENTERED-RANGE. 

DISPLAY 'B150: START' 

OPEN INPUT REFER- FILE 
IF RF-SUCCESSFUL-IO 

SET RF-REFER-OPEN TO TRUE 
ELSE 

DISPLAY '*** ERROR OPENING REFERENCE FILE *** ' 

'STATUS: ' RF-STATUS 
SET BRC-OPEN-ERROR TO TRUE 
GO TO B150-GET-ENTERED-RANGE-EXIT 
END- I F 

SET RF- DATE-RANGE- SELECT I ON TO TRUE 
MOVE REFERENCE- FILE- VALUES TO RF-TABLE-ID 
MOVE WS-PROGRAM-ID TO RF-T ABLE-ENTRY- ID 

MOVE RF-KEY TO RF- PRIME-KEY 

READ REFER- FILE INTO RF-REFERENCE-RECORD 
KEY IS RF- PRIME-KEY 

IF NOT RF-SUCCESSFUL-IO 

SET BRC-IO-ERROR TO TRUE 

DISPLAY ERROR READING REFERENCE FILE *** 1 

'STATUS: ' RF-STATUS 
GO TO B150-GET-ENTERED-RANGE-EXIT 
END-IF 

DEBUGX DISPLAY ' REFERENCE RECORD: ' RF-REFERENCE-RECORD 

DEBUGX DISPLAY ' REFERENCE FILE DATES: ' 

DEBUGX DISPLAY 'FROM DATE: ' RF-FROM-DATE-X1 4 

DEBUGX ' TO DATE: ' RF-TO-DATE-X14 



MOVE RF- FROM- DATE-X 1 4 
MOVE RF- FROM- DATE-X 1 4 (9 



TO BDT-DATE 
6) TO BDT-TIME 



MOVE '1' TO BDT-PROCESS-DIR 

PERFORM D000-GMTCONV-PROCESS THRU 
D000-GMTCONV-PROCESS-EXIT 
IF BRC-STOP-PROCESSING 

GO TO B15 0-GET-ENTERED-RANGE-EXIT 
END-IF 



MOVE RF- TO- DATE-X 14 

MOVE RF- TO- DATE-X 14 (9:6) 



TO BDT-DATE 
TO BDT-TIME 



MOVE '1' TO BDT-PROCESS-DIR 

PERFORM D000-GMTCONV-PROCESS THRU 
D000-GMTCONV-PROCESS-EXIT 
IF BRC-STOP-PROCESSING 

GO TO B150-GET-ENTERED-RANGE-EXIT 
END-IF 



MOVE RF- FROM- DATE-X 1 4 



TO WS-DT-TM-X 



00051400 
00051500 
00051600 
00051700 
00051800 
00051900 
00052000 
00052100 
00052200 
00052300 
00052400 
00052500 
00052600 
00052700 
00052800 
00052900 
00053000 
00053100 
00053200 
00053300 
00053400 
00053500 
00053600 
00053700 
00053800 
00053900 
00054000 
00054100 
00054200 
00054300 
00054400 
00054500 
00054600 
00054700 
00054800 
00054900 
00055000 
00055100 
00055200 
00055300 
00055400 
00055500 
00055600 
00055700 
00055800 
00055900 
00056000 
00056100 
00056200 
00056300 
00056400 
00056500 
00056600 
00056700 
00056800 
00056900 
00057000 



WS-FR0M-DATE-X14 

PERFORM D180-DATE-X14-TO-ORA THRU 
D180-DATE-X14-TO-ORA-EXIT 
MOVE WS-ORA-DT-TM TO WS - FROM- DATE 

MOVE RF- TO- DATE -XI 4 TO WS-DT-TM-X 

WS-TO-DATE-X1 4 

PERFORM D180-DATE-X14-TO-ORA THRU 
D180-DATE-X14-TO-ORA-EXIT 
MOVE WS-ORA-DT-TM TO WS-TO-DATE 

B150-GET-ENTERED-RANGE-EXIT . 
EXIT. 

C000-PROCESS-CUSTOMER. 

DISPLAY 'C000: START ' 



/ 



TO WS-ORA-DT-TM 



* FETCH BENEFITS BY LOAD DATE/TIME 
* 

PERFORM VI 50- FETCH- BENEFITS-LOAD THRU 
VI 50- FETCH-BENEFITS -LOAD-EXIT 

DEBUGX DISPLAY 'BENEFITS ROW: T BENEFITS-ROW 

EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 
IF FIRST-TIME 

MOVE BEN-LOAD-DT-TM 
PERFORM D100-DATE-ORA-X14 THRU 
D100-DATE-ORA-X14-EXIT 
MOVE WS-DT-TM-X TO WS-BEN-LOAD-DT-TM-Xl 4 

SET NOT-FIRST-TIME TO TRUE 

MOVE BEN-CUSTOMER-ID TO WS-PREV-CUST-ID 

MOVE WS-BEN-LOAD-DT-TM-Xl 4 

TO WS-PREV-LOAD-DT-TM-X14 

PERFORM P5 00- HEADINGS THRU 
P5 00 -HEADINGS -EX IT 

END-IF 

IF BRC-IN-PROCESS 

PERFORM C100-SUM-BENEFITS THRU 
C100-SUM-BENEFITS-EXIT 

END-IF 

WHEN ORA-SQL-ROW-NOT-FOUND 

SET BRC-SUCCESSFUL-COMPLETION TO TRUE 

WHEN OTHER 

SET BRC- SQL-ERROR TO TRUE 
DISPLAY 

•I/O ERROR - BENEFITS LOAD CURSOR ' 
END-EVALUATE 

* SET BRC-SUCCESSFUL-COMPLETION TO TRUE 

C000-PROCESS-CUSTOMER-EXIT . 
EXIT. 

/ 



00057100 
00057200 
00057300 
00057400 
00057500 
00057600 
00057700 
00057800 
00057900 
00058000 
00058100 
00058200 
00058300 
00058400 
00058500 
00058600 
00058700 
00058800 
00058900 
00059000 
00059100 
00059200 
00059300 
00059400 
00059500 
00059600 
00059700 
00059800 
00059900 
00060000 
00060100 
00060200 
00060300 
00060400 
00060500 
00060600 
00060700 
00060800 
00060900 
00061000 
00061100 
00061200 
00061300 
00061400 
00061500 
00061600 
00061700 
00061800 
00061900 
00062000 
00062100 
00062200 
00062300 
00062400 
00062500 
00062600 
00062700 



DEBUGX 
DEBUGX 



C100-SUM-BENEFITS. 

DISPLAY 'ClOO: ' 

MOVE BEN-LOAD-DT-TM 
PERFORM D100-DATE-ORA-X14 THRU 
D100-DATE-ORA-X14-EXIT 
MOVE WS-DT-TM-X 

DISPLAY 'C100: PREV LOAD DT : ' 



DEBUGX 



DEBUGX 



DEBUGX 



TO WS-ORA-DT-TM 



TO WS-BEN-LOAD-DT-TM-X1 4 
WS-PREV-LOAD-DT-TM-X14 



' BEN LOAD DT: 



WS - BEN-LOAD- DT-TM-X1 4 



WS-PREV-CUST-ID 



WS-PREV-CUST-ID 



EVALUATE TRUE 

WHEN BEN-CUSTOMER-ID NOT 
DISPLAY 'C100: CUST BREAK' 

PERFORM P100-PRT-LOAD-DT-TOTAL THRU 
P100-PRT-LOAD-DT-TOTAL-EXIT 
PERFORM P300-PRT-CUST -TOTAL THRU 
P300-PRT-CUST-TOTAL-EXIT 
MOVE BEN-CUSTOMER-ID TO 
PERFORM P500-HEADINGS THRU 
P5 00 -HEADINGS-EXIT 
MOVE BEN-LOAD-DT-TM TO WS-PREV-LOAD-DT-TM 

MOVE WS-BEN-LOAD-DT-TM-X14 TO WS- PREV-LOAD-DT-TM-X1 4 

WHEN WS -BEN-LOAD- DT-TM-X1 4 

NOT = WS-PREV-LOAD-DT-TM-X14 
DISPLAY 'C100: LOAD DT BREAK'- 

PERFORM P100-PRT-LOAD-DT-TOTAL THRU 
P100-PRT-LOAD-DT-TOTAL-EXIT 
MOVE BEN-LOAD-DT-TM TO WS-PREV-LOAD-DT-TM 

MOVE WS- BEN-LOAD- DT-TM-X 14 TO WS-PREV-LOAD-DT-TM-X1 4 

END-EVALUATE 

IF BRC-IN-PROCESS 
DISPLAY 'C100: ADD AMOUNTS ' 

ADD 1 TO WS -BEN-LOAD- DT-CNT 

ADD BEN-INITIAL-VAL-AMT TO WS -BEN-LOAD- DT-AMT 
END- IF 

C100-SUM-BENEFITS-EXIT. 
EXIT. 

D000-GMTCONV-PROCESS . 

CALL 'CWCB3000 1 USING CWCB3 00.0 -PASS -AREA 

IF BDT-RTN-CODE > 0 

MOVE BDT-RTN-CODE TO BRC-RETURN-CODE 

DISPLAY ' BDT-RTN-CODE = ' BDT-RTN-CODE 

DISPLAY ' PASS AREA - ' CWCB3 000 -PASS -AREA 
END-IF 

D000-GMTCONV-PROCESS-EXIT . 
EXIT. 



/ 



00062800 
00062900 
00063000 
00063100 
00063200 
00063300 
00063400 
00063500 
00063600 
00063700 
00063800 
00063900 
00064000 
00064100 
00064200 
00064300 
00064400 
00064500 
00064600 
00064700 
00064800 
00064900 
00065000 
00065100 
00065200 
00065300 
00065400 
00065500 
00065600 
00065700 
00065800 
00065900 
00066000 
00066100 
00066200 
00066300 
00066400 
00066500 
00066600 
00066700 
00066800 
00066900 
00067000 
00067100 
00067200 
00067300 
00067400 
00067500 
00067600 
00067700 
00067800 
00067900 
00068000 
00068100 
00068200 
00068300 
00068400 



* CONVERTS AN ORACLE DATE/TIME TO : 


PIC 


X14 CCYYMMDDHHMMSS 


*00068500 




D100-DATE- 


-ORA-X14 . 








00068700 












00068800 


MOVE 


WS-ODT-BYTE 


(1) 


TO 


WS-B2-LO 


00068900 


SUBTRACT 100 FROM WS-BIN-2N 






00069000 


MOVE 


WS-BIN-2N 




TO 


WS-DT-CC 


00069100 


MOVE 


WS-ODT-BYTE 


(2) 


TO 


WS-B2-LO 


00069200 


SUBTRACT 100 FROM WS-BIN-2N 






00069300 


MOVE 


WS-BIN-2N 




TO 


WS-DT-YY 


00069400 


MOVE 


WS-ODT-BYTE 


(3) 


TO 


WS-B2-LO 


00069500 


MOVE 


WS-BIN-2N 




TO 


WS-DT-MM 


00069600 


MOVE 


WS-ODT-BYTE 


(4) 


TO 


WS-B2-LO 


00069700 


MOVE 


WS-BIN-2N 




TO 


WS-DT-DD 


00069800 


MOVE 


WS-ODT-BYTE 


(5) 


TO 


WS-B2-LO 


00069900 


SUBTRACT 1 FROM WS-BIN-2N 






00070000 


MOVE 


WS-BIN-2N 




TO 


WS-DT-HH 


00070100 


MOVE 


WS-ODT-BYTE 


(6) 


TO 


WS-B2-LO 


00070200 


SUBTRACT 1 FROM WS-BIN-2N 






00070300 


MOVE 


WS-BIN-2N 




TO 


WS-DT-MI 


00070400 


MOVE 


WS-ODT-BYTE 


(7) 


TO 


WS-B2-LO 


00070500 


SUBTRACT 1 FROM WS-BIN-2N 






00070600 


MOVE 


WS-BIN-2N 




TO 


WS-DT-SS 


00070700 












00070800 


D100-DATE- 


-ORA-X14-EXIT 








00070900 


EXIT. 










00071000 












00071100 






Dl 80- DATE- 


-X14-TO-ORA. 








00071400 


MOVE 


WS-DT-CC 




TO 


WS-BIN-2N 


00071500 


ADD 


100 TO 


WS-BIN-2N 






00071600 


MOVE 


WS-B2-LO 




TO 


WS-ODT-BYTE (1) 


00071700 


MOVE 


WS-DT-YY 




TO 


WS-BIN-2N 


00071800 


ADD 


100 TO 


WS-BIN-2N 






00071900 


MOVE 


WS-B2-LO 




TO 


WS-ODT-BYTE (2) 


00072000 


MOVE 


WS-DT-MM 




TO 


WS-BIN-2N 


00072100 


MOVE 


WS-B2-LO 




TO 


WS-ODT-BYTE (3) 


00072200 


MOVE 


WS-DT-DD 




TO 


WS-BIN-2N 


00072300 


MOVE 


WS-B2-LO 




TO 


WS-ODT-BYTE (4) 


00072400 


MOVE 


WS-DT-HH 




TO 


WS-BIN-2N 


00072500 


ADD 


1 TO 


WS-BIN-2N 






00072600 


MOVE 


WS-B2-LO 




TO 


WS-ODT-BYTE (5) 


00072700 


MOVE 


WS-DT-MI 




TO 


WS-BIN-2N 


00072800 


ADD 


1 TO 


WS-BIN-2N 






00072900 


MOVE 


WS-B2-LO 




TO 


WS-ODT-BYTE (6) 


00073000 


MOVE 


WS-DT-SS 




TO 


WS-BIN-2N 


00073100 


ADD 


1 TO 


WS-BIN-2N 






00073200 


MOVE 


WS-B2-LO 




TO 


WS-ODT-BYTE (7) 


00073300 












00073400 


D180-DATE- 


-X14-TO-ORA-EXIT. 






00073500 


EXIT . 










00073600 


/ 










00073700 


E000-CLEAN-UP . 








00073800 





* THIS PROCESS CLOSES FILES AND PERFORMS OTHER POST-PROCESS 

* TASKS 



ING 



*00074000 
*00074100 



SET PC-EOJ TO TRUE 



IF NOT FIRST-T 
PERFORM PI 00 
P100 
P300 
P300 
P500 
P500 



PERFORM 

PERFORM 

ELSE 

PERFORM 

PERFORM 

END-IF 



IME 

- PRT - LOAD- DT- TOTAL THRU 
-PRT-LOAD-DT-TOTAL-EXIT 
-PRT-CUST-TOTAL THRU 
-PRT-CUST-TOTAL-EXIT 
-HEADINGS THRU 
-HEADINGS-EXIT 

P5 00 -HEADINGS THRU 
P5 00 -HEADINGS -EX IT 
P550-NO-PROC-MSG THRU 
P550-NO-PROC-MSG-EXIT 



PERFORM P4 00- PRT -RE PORT- TOTAL THRU 
P4 00- PRT -RE PORT- TOTAL-EXIT 

* CLOSE FILES 

CLOSE PRINT-FILE 

E000-CLEAN-UP-EXIT . 
EXIT. 

P100-PRT-LOAD-DT-TOTAL. 



/ 



DEBUGX 



DISPLAY 'P100: 



START' 



MOVE WS-PREV-LOAD-DT-TM 
PERFORM D100-DATE-ORA-X14 THRU 
D100-DATE-ORA-X14-EXIT 
MOVE WS-DT-TM-X 
MOVE WS-PREV-LOAD-DT-TM-X14 

MOVE WS-PD-MM 

MOVE WS-PD-DD 

MOVE WS-PD-YY 

MOVE WS-PD-HH 

MOVE WS-PD-MI 

MOVE WS-PD-SS 

MOVE WS-PREV-LOAD-DT-TM-X17 

MOVE WS-BEN-LOAD-DT-CNT 
MOVE WS-BEN-LOAD-DT-AMT 
WRITE PRT-RECORD FROM DETAIL-LINE1 AFTER 1 



TO WS-ORA-DT-TM 



TO WS- PROCESS -DATE-X 14 

TO WS- PROCESS -DATE-X 14 

TO WS-PLD-MM 

TO WS-PLD-DD 

TO WS-PLD-YY 

TO WS-PLD-HH 

TO WS-PLD-MI 

TO WS-PLD-SS 

TO DL1- LOAD- DATE 

TO DL1-BEN-CNT 

TO DL1-BEN-AMT 



ADD WS-BEN-LOAD-DT-CNT 

ADD WS-BEN-LOAD-DT-AMT 

MOVE ZERO 

MOVE ZERO 

P100-PRT-LOAD-DT-TOTAL-EXIT . 



TO WS-BEN-CUST-TOT-CNT 

TO WS-BEN-CUST-TOT-AMT 

TO WS-BEN-LOAD-DT-CNT 
TO WS-BEN-LOAD-DT-AMT 



***00074200 
00074300 
00074400 
00074500 
00074510 
00074540 
00074600 
00074700 
00074800 
00074900 
00075000 
00074520 
00074530 
00075400 
00074520 
00074530 
00075200 
00075300 
00075400 
00075500 
00075800 
00075900 
00076000 
00076100 
00076200 
00076300 
00076400 
00076500 
00076600 
00076700 
00076800 
00076900 
00077000 
00077100 
00077200 
00077300 
00077400 
00077500 
00077600 
00077700 
00077800 
00077900 
00078000 
00078100 
00078200 
00078300 
00078400 
00078500 
00078600 
00078700 
00078800 
00078900 
00079000 
00079100 
00079200 
00079300 
00079400 



EXIT. 



/ 



P300-PRT-CUST-TOTAL. 
DEBUGX DISPLAY 'P300: 



START ' 



MOVE 'TOTAL LOADED ' TO DL1 -LOAD-DATE 

MOVE WS-BEN-CUST-TOT-CNT TO DLl-BEN-CNT 

MOVE WS-BEN-CUST-TOT-AMT TO DLl-BEN-AMT 

WRITE PRT-RECORD FROM DETAIL-LINE1 AFTER 1 



WS -BEN- REPORT- TOT -CNT 
WS-BEN- REPORT- TOT- AMT 

TO WS-BEN-CUST-TOT-CNT 
TO WS-BEN-CUST-TOT-AMT 



ADD WS-BEN-CUST-TOT-CNT TO 
ADD WS-BEN-CUST-TOT-AMT TO 
MOVE ZERO 
MOVE ZERO 

P 30 0-PRT-CUST- TOTAL- EXIT . 
EXIT. 

/ 

P4 00-PRT-RE PORT-TOTAL . 
DEBUGX DISPLAY 'P400: START' 

MOVE 'REPORT TOTALS 1 TO DL1- LOAD- DATE 

MOVE WS-BEN- RE PORT -TOT-CNT TO DLl-BEN-CNT 

MOVE WS-BEN-REPORT-TOT-AMT TO DLl-BEN-AMT 

WRITE PRT-RECORD FROM DETAIL-LINE1 AFTER 1 

P4 00- PRT-REPORT -TOTAL-EXIT . 
EXIT. 

/ 

P500-HEADINGS. 



DISPLAY 'P500: 
MOVE 'P500: 



START' 



TO WORK- PARA 



WRITE PRT-RECORD FROM HEAD I NG- LINE 1 AFTER TOP-OF-PAGE 
WRITE PRT-RECORD FROM HEADING-LINE2 AFTER 1 
WRITE PRT-RECORD FROM HEADING- LI NE3 AFTER 2 
IF NOT PC-EOJ 

PERFORM P530-PRINT-CUST-DATA THRU 
P530-PRINT-CUST-DATA-EXIT 

END-IF 

WRITE PRT-RECORD FROM HEADING- LINE 4 AFTER 2 
WRITE PRT-RECORD FROM PC-SPACES AFTER 1 

ADD 1 TO PC-PAGE-NUM 

MOVE PC-PAGE-NUM TO HLl- PAGE-NUMBER 

MOVE 6 TO PC-LINE-CNT 

P5 00 -HEADINGS -EX IT . 
EXIT. 

/ 

* SELECT CUSTOMER ROW AND PRINTS CUSTOMER DATA 

P530-PRINT-CUST-DATA. 

* DISPLAY 'P530: START' 

PERFORM V200-SELECT-CUSTOMER THRU 



00079500 
00079600 
00079700 
00079800 
00079900 
00080000 
00080100 
00080200 
00080300 
00080400 
00080500 
00080600 
00080700 
00080800 
00080900 
00081000 
00081100 
00081200 
00081300 
00081400 
00081500 
00081600 
00081700 
00081800 
00081900 
00082000 
00082100 
00082200 
00082300 
00082400* 
00082500 
00082600 
00082700 
00082800 
00082900 
00083000 
00083100 
00083200 
00083300 
00083400 
00083500 
00083600 
00083700 
00083800 
00083900 
00084000 
00084100 
00084200 
00084300 
00084400 

**00084500 
*00084600 

**00084700 
00084800 
00084900 
00085000 
00085100 



V200-SELECT-CUSTOMER-EXIT 

EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 
DISPLAY ' CUSTOMER ROW: * CUSTOMER- ROW 

MOVE 'CUSTOMER ID ' TO CL-HEADER 

MOVE CUS-CUSTOMER-ID TO CL-DATA 
WRITE PRT-RECORD FROM CUST-LINE1 AFTER 1 

* CUSTOMER NAME 

MOVE 'CUSTOMER NAME ' TO CL-HEADER 
IF CUS-CUSTOMER-NAME-LEN > ZERO 

MOVE CUS-CUSTOMER-NAME-ARR TO CL-DATA 
ELSE 

MOVE SPACES TO CL-DATA 
END-IF 

WRITE PRT-RECORD FROM CUST-LINE1 AFTER 1 



STREET ADDRESS 1 
MOVE 'ADDRESS 1 

IF CUS- STREET- ADDR1-LEN > 

MOVE CUS- STREET- ADDR1-ARR 
ELSE 

MOVE SPACES 
END-IF 

WRITE PRT-RECORD FROM CUST-LINE1 AFTER 1 



TO CL-HEADER 
ZERO 

TO CL-DATA 

TO CL-DATA 



STREET ADDRESS 2 
MOVE 'ADDRESS 2 

IF CUS- STREET -ADDR2-LEN > 

MOVE CUS- STREET- ADDR2-ARR 
ELSE 

MOVE SPACES 
END-IF 

WRITE PRT-RECORD FROM CUST-LINEl AFTER 1 



TO CL-HEADER 
ZERO 

TO CL-DATA 

TO CL-DATA 



CITY, STATE ZIP 
MOVE SPACES 
MOVE 'CITY, STATE ZIP 
MOVE SPACES 
MOVE CUS-CITY-LEN 
IF PLEN > ZERO 

MOVE CUS-CITY-ARR 

ADD 1 TO PLEN 

MOVE ' , ? 

ADD 2 TO PLEN 
ELSE 

MOVE 1 
END-IF 

IF CUS- STATE- LEN > 
MOVE CUS- STATE- ARR 
ADD 3 TO PLEN 

END-IF 

IF CUS-ZIPCODE-LEN 



TO CL-DATA 

TO CL-HEADER 

TO CL-DATA 

TO PLEN 

TO CL-DATA (1 : PLEN) 

TO CL-DATA (PLEN : 2) 

TO PLEN 



ZERO 



TO CL-DATA (PLEN 



2) 



ZERO 



00085200 
00085300 
00085400 
00085500 
00085600 
00085700 
00085800 
00085900 
00086000 
00086100 
00086200 
00086300 
00086400 
00086500 
00086600 
00086700 
00086800 
00086900 
00087000 
00087100 
00087200 
00087300 
00087400 
00087500 
00087600 
00087700 
00087800 
00087900 
00088000 
00088100 
00088200 
00088300 
00088400 
00088500 
00088600 
00088700 
00088800 
00088900 
00089000 
00089100 
00089200 
00089300 
00089400 
00089500 
00089600 
00089700 
00089800 
00089900 
00090000 
00090100 
00090200 
00090300 
00090400 
00090500 
00090600 
00090700 
00090800 



MOVE CUS-ZIPCODE-ARR 
ADD 5 TO PLEN 
END-IF 



TO CL-DATA ( PLEN : 5) 



IF CUS-ZIPCODE-4-LEN > ZERO 
MOVE '-' TO CL-DATA (PLEN : 1) 
ADD 1 TO PLEN 

MOVE CUS-ZIPCODE-4-ARR TO CL-DATA (PLEN : 4) 

END-IF 

WRITE PRT-RECORD FROM CUST-LINE1 AFTER 1 

* * * * CONTRACT NUMBER, PO NUMBER ????? 

MOVE 'ACCOUNTS RECEIVABLE MISCELLANEOUS DATA: ' 

TO CL-HEADER 
IF CUS-ACCTS-RECV-MISC-DATA-LEN > ZERO 

MOVE CUS-ACCTS-RECV-MISC-DATA-ARR TO CL-DATA 
ELSE 

MOVE SPACES TO CL-DATA 

END-IF 

WRITE PRT-RECORD FROM CUST-LINE1 AFTER 2 

* * * * USER ID OF CONTACT PERSON W/ TITLE 

MOVE 'CONTACT NAME, TITLE ' TO CL-HEADER 



MOVE CUS-CONTACT-USER-ID-LEN 
IF PLEN > ZERO 

MOVE CUS-CONTACT-USER-ID-ARR 
ELSE 

MOVE SPACES 
END-IF 



TO PLEN 
TO CL-DATA 
TO CL-DATA 



IF CUS-CONTACT-TITLE-LEN 

ADD 1 TO PLEN 

MOVE ' , ' 

ADD 3 TO PLEN 

MOVE CUS- CONTACT- TITLE- ARR 
END-IF 

WRITE PRT-RECORD FROM CUST-LINEl AFTER 1 



> ZERO 

TO CL-DATA (PLEN 
TO CL-DATA (PLEN 



* * * * TELEPHONE NUMBER OF CUSTOMER 

MOVE 'PHONE NUMBER ' TO CL-HEADER 

IF CUS-PHONE-NUMBER-LEN > ZERO 

MOVE CUS- PHONE-NUMBER-ARR TO CL-DATA 

ELSE 

MOVE SPACES TO CL-DATA 

END-IF 

WRITE PRT-RECORD FROM CUST-LINEl AFTER 1 

WHEN ORA-SQL-ROW-NOT-FOUND 

SET BRC-SUCCESSFUL-COMPLETION TO TRUE 

WHEN OTHER 

SET BRC- SQL-ERROR TO TRUE 
DISPLAY 

'I/O ERROR - CUSTOMER SELECT ' 
END-EVALUATE 

P530-PRINT-CUST-DATA-EXIT . 



20) 



00090900 
00091000 
00091100 
00091200 
00091300 
00091400 
00091500 
00091600 
00091700 
00091800 
00091900 
00092000 
00092100 
00092200 
00092300 
00092400 
00092500 
00092600 
00092700 
00092800 
00092900 
00093000 
00093100 
00093200 
00093300 
00093400 
00093500 
00093600 
00093700 
00093800 
00093900 
00094000 
00094100 
00094200 
00094300 
00094400 
00094500 
00094600 
00094700 
00094800 
00094900 
00095000 
00095100 
00095200 
00095300 
00095400 
00095500 
00095600 
00095700 
00095800 
00095900 
00096000 
00096100 
00096200 
00096300 
00096400 
00096500 



EXIT . 



* PRINTS NO BENEFITS PROCESSED BANNER MESSAGE 
************************************************** + + +■*** + *■*■ 

P550-NO-PROC-MSG. 



DISPLAY 'P550: START 1 



* 


WRITE 


PRT- 


RECORD 


FROM 


BAN1 


-LI 


AFTER 


3 




WRITE 


PRT- 


RECORD 


FROM 


BAN1 


-L2 


AFTER 


1 




WRITE 


PRT- 


RECORD 


FROM 


BAN1 


-L3 


AFTER 


3 


* 


WRITE 


PRT- 


RECORD 


FROM 


BAN1 


-L2 


AFTER 


1 


* 


WRITE 


PRT- 


RECORD 


FROM 


BAN1 


-LI 


AFTER 


1 



P550-NO-PROC-MSG-EXIT . 
EXIT. 

/ 

*********************************************************** 

* CHECKS FOR DATABASE ERRORS 

* IF DATABASE ERROR DISPLAYS MESSAGE TO SYSOUT 
*********************************************************** 

Q000-CHECK-SQLCODE . 



DISPLAY 'Q000: 
MOVE SQLCODE 



START 1 



TO ORA-NAMED- SQLCODE 
ORA-SQLCODE-DISP-4 



EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 
WHEN ORA-SQL-ROW-NOT-FOUND 
CONTINUE 



DATABASE ERROR 

WHEN OTHER 

SET WS-DB-ERROR TO TRUE 
DISPLAY 

' *** SQL ERROR *** 
' SQLCODE : ' 
' MESSAGE : ' 
f PARA: ' 
' TABLE : * 
' FUNCTION: 1 



ORA-SQLCODE-DISP-4 
SQLERRMC 
WORK- PARA 
ORA- TABLE- ID 
ORA-FUNCTION-ID 



/ 



END- EVALUATE 

Q000-CHECK-SQLCODE-EXIT . 
EXIT . 

V100-OPEN-BEN-LOAD . 

* DISPLAY 'V100: START' 

MOVE 'V100: 

MOVE ' OPEN CUR 1 

MOVE ' BENEFIT-LOAD ' 



TO WORK- PARA 

TO ORA-FUNCTION-ID 

TO ORA- TABLE- ID 



00 
00 

******* QQ 

*00 

******* QQ 

00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 

******* QQ 

*00 
*00 

****** * QQ 

00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 



096600 
096700 
096800 
096900 
097000 
097100 
097200 
097300 
097400 
097500 
097600 
097700 
097800 
097900 
098000 
098100 
098200 
098300 
098400 
098500 
098600 
098700 
098800 
098900 
099000 
099100 
099200 
099300 
099400 
099500 
099600 
099700 
099800 
099900 
100000 
100100 
100200 
100300 
100400 
100500 
100600 
100700 
100800 
100900 
101000 
101100 
101200 
101300 
101400 
101500 
101600 
101700 
101800 
101900 
102000 
102100 
102200 



EXEC SQL OPEN 

BENEFITS_LOAD 
END-EXEC 

PERFORM Q000-CHECK-SQLCODE 

THRU Q000-CHECK-SQLCODE-EXIT 

IF ORA-SQL-SUCCESSFUL 

CONTINUE 
ELSE 

SET BRC- SQL-ERROR TO TRUE 
END-IF 

V100-OPEN-BEN-LOAD-EXIT . 
EXIT . 

VI 50- FETCH-BENEFITS- LOAD . 
" DISPLAY 'V150: START 1 



/ 



'V150: 
' FETCHCUR 1 
1 BENEFIT-LOAD 1 



FETCH 



BENEFITS LOAD 



/ 



MOVE 
MOVE 
MOVE 

EXEC SQL 
INTO 

-INC CWELB805 

END-EXEC 



PERFORM Q000-CHECK-SQLCODE 

THRU Q000-CHECK-SQLCODE-EXIT 

VI 50- FETCH-BENEFITS -LOAD-EXIT . 
EXIT. 

V2 00- SELECT -CUSTOMER. 
* DISPLAY 'V200: START 1 
MOVE 'V200: 
MOVE 1 SELECT 1 

MOVE 'CUSTOMER ' 

INITIALIZE CUSTOMER-ROW 

* 

EXEC SQL SELECT 
-INC CWELB8 20 

INTO 

-INC CWELB825 

FROM MCHECK. CUSTOMER 
WHERE CUSTOMER_ID = 
END-EXEC 



TO WORK- PARA 

TO ORA-FUNCTION-ID 

TO ORA-TABLE-ID 



TO WORK- PARA 

TO ORA-FUNCTION-ID 

TO ORA-TABLE-ID 



: BEN-CUSTOMER-ID 



PERFORM Q000-CHECK-SQLCODE 

THRU Q000-CHECK-SQLCODE-EXIT 

V2 00- SELECT-CUSTOMER-EXIT . 
EXIT. 



□ 



00102300 
00102400 
00102500 
00102600 
00102700 
00102800 
00102900 
00103000 
00103100 
00103200 
00103300 
00103400 
00103500 
00103600 
00103700 
00103800 
00103900 
00104000 
00104100 
00104200 
00104300 
00104400 
00104500 
00104600 
00104700 
0010480% 
00104900 
00105000 
00105100 
00105200 
00105300 
00105400 
00105500 
00105600 
00105700 
00105800 
00105900 
00106000 
00106100 
00106200 
00106300 
00106400 
00106500 
0010660% 
00106700 
0010680% 
00106900 
00107000 
00107100 
00107200 
00107300 
00107400 
00107500 
00107600 
00107700 



APPENDIX E 



IDENTIFICATION DIVISION. 

PROGRAM- ID . CWUCB500 . 
AUTHOR. CUBIC/CTS. 
INSTALLATION. 

DATE-WRITTEN . DECEMBER 1999. 
DATE-COMPILED. 

* PROGRAM NAME : CLAIM CONFIRMATION PROCESS (EUB5) * 

* PROGRAM ID : CWUCB500 . * 

* * 

* SYSTEM: 9121-490 MVS/ESA, CICS, COBOL II, VSAM, ORACLE * 

* PROJECT: 170-2719 ELECTRONIC BENEFITS DISTRIBUTION SYSTEM * 

* ON-LINE MONITORING AND CONTROL. * 

* * 

* DESC: THIS PROGRAM HANDLES THE MESSAGE (EUB5), WHICH * 

* CONFIRMS THE BENEFITS WRITTEN TO A PATRAON ' S * 

* GO CARD. * 

* * 

* UPDATES EACH BENEFIT ROW THAT WAS IDENTIFIED IN THE * 

* EUB5 MESSAGE. * 

* * 

* INSERT A CLAIMS ROW FOR EACH BENEFIT ROW UPDATED. * 

* * 

* LOG BE FORE /AFTER IMAGES OF EACH ROW INSERTED/UPDATED. * 

* * 

* INPUTS: MESSAGE LINKAGE AREA (PASS-AREA) * 

* BENEFITS TABLE (ORACLE) * 

* * 

* OUTPUTS: MESSAGE LINKAGE AREA (PASS-AREA MACK) * 

* CLAIMS TABLE (ORACLE) * 

* BENEFITS TABLE (ORACLE) * 

* SYSTEM LOG * 

* * 

* ERRORS: PASSED TO CWAC5300 IN 1 MLA- RETURN-CODE 1 * 

* ALL ERRORS FROM THIS PROCESS WILL BE LOGGED IN THE * 

* SYSTLOG FILES. * 

* * 

* REVISION HISTORY : * 

* 02/22/00 SMB0O0 RONO COMMENTED OUT ALL DEBUG LOGGER PERFORMS *00004400 

* 12/15/99 SMB0O0 RONO INITIAL * 
/ 

ENVIRONMENT DIVISION. 
DATA DIVISION. 
WORKING-STORAGE SECTION. 

01 WS-WORKAREA. 

05 WS-PROGRAM-ID PIC X(08) VALUE ' CWUCB500 1 . 

05 FILLER PIC X(13) VALUE 

' COMPILED ON: ' . 
05 WS-WHEN-COMPILED PIC X(16). 



01 


ws- 


TRACE -AREA. 










05 


FILLER 

' *** TRACE AREA*** ' . 


PIC 


X(16) 


VALUE 




05 


WORK- PARA 


PIC 


X(08) . 




* 


05 


TRACE-CYCLE 


PIC 


9(05) 


VALUE ZEROES 




05 


FILLER 


PIC 


X(02) 


VALUE ' ** ' . 




05 


PARA- ID 


PIC 


X(08) 








OCCURS 40 TIMES 








* 




INDEXED BY PARA-NDX . 









01 WS-PROCESS-AREA. 
COPY CWWL0080. 



01 WS-MISC-FIELDS. 
05 IDXD 
05 IDXR 

* MAXIMUM NUMBER OF REQUESTS ALLOWED ON 

05 WS-VALID-MAX-REQ-NUM PIC 

05 WS-MAX-REQ-NUM PIC 

SMBOOO 05 WS-BEN-FETCH-CNT PIC 

SMBOOO 05 WS-CLM-FETCH-CNT PIC 

05 WS-SAVE-AUTH-CDE PIC 

05 WS-SAVE-RETR-REF-NUM PIC 
05 WS-AUTHORIZATION-CDE. 

10 WS-AC-RU-NUM PIC 

10 WS-AC-DEV-NUM PIC 

10 WS-AC-GMT PIC 

05 WS-REQ-TOT-AMT PIC 

WS-REQ-TOT-AMT-C3 PIC 

WS-OVER-CLAIM-AMT PIC 

WS -OVER-CLAIM- AMT-C3 PIC 

WS-DI FF-AMT-C3 PIC 

WS-BEN-REM-VAL-AMT PIC 

WS-CLM-REM-VAL-AMT PIC 

WS-EUB5-REQ-VAL-AMT PIC 

WS-SAVE-INP-MSG-ID PIC 

WS-CLAIM-UPD-FLAG PIC 
WS-SET-CLAIM-UPD-FLAG VALUE 
WS-CLAIM-UPDATED VALUE 

WS- UP DATE-BENEFITS -FLAG PIC 
WS- START- BENE FITS -ALLOC 
WS- BENE FITS -NOT-UPDATED 
WS-BENE FITS-UPDATED 

WS-APPLY-CREDIT-FLAG PIC 
WS- STANDARD-CLAIM 
WS-APPLY-CREDIT-CLAIM 



PIC S9(4) COMP. 

PIC S9(4) COMP. 

IN AN EUB5 MESSAGE 

S9 (4) COMP VALUE 15, 

S9(4) COMP. 

S9(4) COMP. 

S9(4) COMP. 

X(15) . 

X(12) . 



05 
05 
05 
05 
05 
05 
05 
05 
05 



05 



05 



999. 
99. 

9(10) . 

S9(8) COMP. 
S9(5)V99 COMP-3. 
S9{8) COMP. 
S9(5)V99 COMP-3. 
S9(5)V99 COMP-3. 
S9(8) COMP. 
S9(8) COMP. 
S9(3)V99 COMP-3. 
S9(8) COMP. 
9. 
ZERO. 
1. 

X VALUE ' N ' . 
VALUE »N' 
VALUE ' N 1 
VALUE ' Y' 
X VALUE ' N ' 
VALUE ' N ' 
VALUE ' Y' 



00007000 
00007100 
00007200 
00007400 
00007400 
00007300 
00007300 
00007300 
00007300 
00007300 
00007300 
00007300 
00007300 
00007300 
00007500 
00007500 
00050600 
00050600 
00050600 
00007600 
00007600 
00007700 
00008300 
00008300 
00008300 
00008300 
00007800 
00007900 
00008000 
00008100 
00007800 
00008000 
00008100 



01 SYSTEM-LOGGER-COMMAREA. 
COPY CWLL3100. 



0 1 MESSAGE-ROUTER-LINKAGE . 
COPY CWLL3300. 



01 



STOP- PROCESS ING-COMMAREA . 
COPY CWLL5800. 



01 COMMON-DEFINITIONS . 
COPY CWWL0020. 



01 SK-CICS-RE FORMAT -AREA . 
COPY CWWL9090. 

/ 

01 EUB5-DATA. 
-INC CWULB500 
/ 

* SQL COPYBOOKS 

01 ORACLE-SQL-CODES . 
COPY CWELBOOO. 

EXEC SQL 

BEGIN DECLARE SECTION 
END-EXEC. 



00011500 
00011600 
00011700 
00011800 
00011900 
00012000 



-INC CWELB100 



BENEFITS HOST VARIABLES 



BENEFITS EQUIVALENCIES 



-INC CWELB101 



BENEFITS DEFINITION HOST VARIABLES 



-INC CWELB1 30 



-INC CWELB131 



-INC CWELB500 



-INC CWELB501 



BENEFITS DEFINITION EQUIVALENCIES 



CLAIMS HOST VARIABLES 



CLAIMS EQUIVALENCIES 



01 WS-SQL-HOST-VARIABLES . 

05 WS-PROCESS-DATE PIC X(7). 

05 WS- PROCESS -DATE-X 14 PIC X{14) 

05 WS-PD-X14 REDEFINES WS-PROCESS-DATE-X1 4 . 
10 WS-PD-DATE. 

15 WS-PD-CC PIC S99. 

15 WS-PD-YY PIC S99. 

15 WS-PD-MM PIC S99. 

15 WS-PD-DD PIC S99. 
10 WS-PD-TIME. 

15 WS-PD-HH PIC S99. 

15 WS-PD-MI PIC S99. 

15 WS-PD-SS PIC S99. 

05 WS-ORA-SERIAL-NUM PIC X(15) 

05 WS-AUTH-CDE PIC X(15) 

r SQL DATA EQUIVALENCING AREA 
EXEC SQL VAR 

WS-PROCESS-DATE IS DATE 
END-EXEC 



00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00014000 
00014000 



EXEC SQL 

INCLUDE SQLCA 
END-EXEC 



EXEC SQL 

END DECLARE SECTION 
END-EXEC 

/ 

* CURSOR DECLARES 

************************** 

* SELECT ALL BENEFITS FOR AUTHORIZATION CODE BEING CLAIMED 

************************** 

EXEC SQL DECLARE BENE FIT S_AUTH CURSOR FOR 
SELECT 

INC CWELB800 

FROM MCHECK. BENEFITS 
WHERE SERIAL_NUM - : WS-ORA-SERIAL-NUM 

AND LAST_AUTH_CDE - :WS-AUTH-CDE 
ORDER BY EXPIRATION_DATE 
FOR UPDATE OF 

INC CWELB800 

END-EXEC 

************************** 

* SELECT ALL CLAIMS FOR AUTHORIZATION CODE BEING CLAIMED 
************************** 

EXEC SQL DECLARE CLAIMS__AUTH CURSOR FOR 

SELECT 

INC CWELB8 10 

FROM MCHECK . CLAIMS 
WHERE SERIAL_NUM = : WS-ORA-SERIAL-NUM 

AND AU T HORI Z AT I ON_C DE = :WS-AUTH-CDE 
ORDER BY EXPIRATION_DATE 
END-EXEC 

/ 

LINKAGE SECTION. 

01 DFHCOMMAREA. 

03 MESSAGE-LINK-AREA. 
COPY CWLL5300. 

/ 

PROCEDURE DIVISION. 
*********************************************************** 

* PROCEDURE DIVISION 

*********************************************************** 

A000-MAIN-ROUTINE . 

MOVE 'AO 00' TO WORK-PARA. 

MOVE WHEN-COMPILED TO WS-WHEN-COMPILED . 

INITIALIZE MESSAGE-ROUTER-LINKAGE. 

EXEC CICS HANDLE ABEND 

LABEL (PROCABEC-ABEND-HANDLER) 



END-EXEC . 

MOVE +1 TO SLC-MESSAGE-LENGTH. 

MOVE SPACES TO SLF-MESSAGE- VALUE . 

SET MACK- BLANK TO TRUE . 

******************************************************** 

MLA-RC-MISCELLANEOUS USED AS AN IN-PROCESS INDICATOR 

IF NOT CHANGED BY THE PROGRAM, THE PROCESS WAS A SUCCESS 
******************************************************** 

IF EIBCALEN > ZEROES 

SET MLA-RC-MISCELLANEOUS TO TRUE 

ELSE 

SET MLA- RC - NO- COMMAREA TO TRUE 
STRING 'B501: ' 

' PROGRAM : ' WS-PROGRAM-ID 

' WAS NOT EXECUTED, NO COMMAREA WAS PASSED. 
1 PARA: ' WORK- PARA 

DELIMITED BY SIZE 

INTO SLF-MESSAGE- VALUE 
WITH POINTER SLC-MESSAGE-LENGTH 
PERFORM PROCABEC-L INK-TO-LOGGER 

THRU PROCABEC- LINK-TO-LOGGER-EXIT 
EXEC CICS RETURN END-EXEC 
END- IF 

SET WS-PROCESS-START TO TRUE 

MOVE MLA- IN PUT -DATA TO EUB5-DATA 

PERFORM E100-EDIT-EUB5-MSG THRU 
El 00-EDIT-EUB5 -MSG-EXIT 

IF WS-PROCESS-COMPLETE 

GO TO A100-END-PROGRAM 
END-IF 

EXEC SQL SELECT SYSDATE 
INTO : WS-PROCESS-DATE 
FROM DUAL 
END-EXEC 

EXEC SQL SELECT TO_CHAR { SYSDATE, 1 YYYYMMDDHH24MISS ' ) 
INTO :WS-PROCESS-DATE-X14 
FROM DUAL 
END-EXEC 

EVALUATE TRUE 
WHEN EUB5-COMPLETED-OK 
PERFORM B100-PROCESS-CLAIMS THRU 
B100-PROCESS-CLAIMS-EXIT 

WHEN EUB5 -VALUE-NOT -USED 
WHEN EUB5 -NOT- PROCESSED 
WHEN EUB5-EV- FAILURE 
CONTINUE 



WHEN OTHER 



SET WS-EDIT-ERROR TO TRUE 
SET MLA-RC-BAD-MLA- TRANS- ID TO TRUE 
END- EVALUATE 

Al 00 -END- PROGRAM . 



TO ORA- TABLE- ID 
TO ORA-FUNCTION-ID 
TO SLC-MES SAGE -LENGTH 
TO SLF-MES SAGE -VALUE 



IF WS-DB-ERROR 

MOVE ' BENEFIT /CLAIMS * 
MOVE 'ROLLBACK' 
MOVE +1 
MOVE SPACES 
STRING 'B109: ' 

ROLLBACK PROCESSED » 

SQLCODE : ' ORA-SQLCODE-DISP-4 
MESSAGE : ' SQLERRMC 
PARA: * WORK- PARA 

BEN ROW: ' BENEFITS- ROW 

CLM ROW: • CLAIMS-ROW 
DELIMITED BY SIZE 

INTO SLF-MES SAGE- VALUE 
WITH POINTER SLC-MES SAGE-LENGTH 
PERFORM PROCABEC-LINK-TO-LOGGER 

THRU PROCABEC-LINK-TO- LOGGER-EXIT 
PERFORM B530-ROLLBACK- TABLES THRU 
B5 30 -ROLLBACK-TABLES -EXIT 

ELSE 

IF WS- PROCESS-SUCCESSFUL 

MOVE 4-1 TO SLC-MES SAGE- LENGTH 

MOVE SPACES TO SLF-MES SAGE- VALUE 

STRING ? B110: 1 

' COMMIT PROCESSED ' 
' BEN ROW: ' BENEFITS-ROW 
' CLM ROW: ' CLAIMS-ROW 
DELIMITED BY SIZE 

INTO SLF-MES SAGE -VALUE 
WITH POINTER SLC-MESS AGE -LENGTH 
PERFORM PROCABEC-LINK-TO-LOGGER 

THRU PROCABEC-LINK-TO-LOGGER- EX IT 
PERFORM B5 4 0-COMMIT-DB- ACTIVITY THRU 
B5 4 0-COMMIT-DB- ACTIVITY-EXIT 

END-IF 
END-IF 



00023800 
00023900 
00039100 
00039100 



00024000 
00024000 
00023900 
00023900 



00056900 
00056900 
00023900 
00024200 



MOVE 'A100' TO WORK-PARA 

EXEC SQL 

CLOSE BENEFITS_AUTH 
END-EXEC 

EXEC SQL 

CLOSE CLAIMS_AUTH 
END-EXEC 



00024800 
00024900 
00024900 
00024900 
00024800 
00024900 
00024900 
00024900 



IF MLA-RC-MISCELLANEOUS 
SET MLA-RC-GOOD 

MACK-PROCESSED TO TRUE 



END-IF 



TRANSFER CONTROL TO THE OUTPUT TRANSACTION MONITOR (OTM) 

SET CD-OTM TO TRUE. 

EXEC CICS XCTL 

PROGRAM (CD-NAMED- PGM) 
COMMAREA (MESS AGE-LINK- AREA) 
LENGTH (LENGTH OF MESS AGE-LINK- AREA) 
RESP (WS-RESP) 
END-EXEC 

IF WS-RESP NOT = DFHRESP (NORMAL) 
EXEC CICS DUMP 

DUMPCODE (MLA-TRANS-ID) 
COMPLETE 

END-EXEC 

EXEC CICS RETURN END-EXEC 
END-IF 

A100-END-PROGRAM-EXIT . 
EXIT. 

PROCESS EACH BENEFIT AGAINST THE CLAIMS CONTAINED IN THE EUB5 * 
MESSAGE. * 
INSERT A CLAIM ROW FOR THE AMOUNT THAT THE BENEFIT CONTRIBUTED* 
TO THE CLAIM AMOUNT. * 

B100-PROCESS-CLAIMS . 



MOVE 


'BENEFITS 1 


TO 


ORA-TABLE- I D 


00068100 


MOVE 


'OPECUR AUTHORIZATION' 


TO 


ORA-FUNCTION-ID 


00068100 


MOVE 


»B100' 


TO 


WORK- PARA 












00068000 


PERFORM TRACE- IT 






00068100 


)PEN AUTHORIZATION CURSOR 








MOVE 


EUB5-SERIAL-NUM 


TO 


WS-SERIAL-NUM 




MOVE 


WS-SN-HI-2 


TO 


WS-OSN-HI-5 


00032800 


MOVE 


WS-SN-LO-4 


TO 


WS-OSN-LO-10 


00032900 


MOVE 


WS-SERIAL-NUM-X15 


TO 


WS-ORA-SERIAL-NUM 


00032900 


MOVE 


EUB5-AUTH-CDE 


TO 


WS-AUTH-CDE 





EXEC SQL 

OPEN BENEFIT S__AUTH 
END-EXEC 

PERFORM Q000-CHECK-SQLCODE THRU 
Q000-CHECK-SQLCODE-EXIT 

IF WS-DB-ERROR 

SET MLA-RC-FAILED-DB-IO TO TRUE 
GO TO B100-PROCESS-CLAIMS-EXIT 

END-IF 



TABLE-ID 
FUNCTION- 



MOVE 'BENEFITS' TO ORA- 

MOVE ' FTCH BENEFITS_AUTH ' TO ORA- 

PERFORM UNTIL WS-PROCESS-COMPLETE 

MOVE 'B100FTCH 1 TO WORK- PARA 

PERFORM TRACE-IT 



ID 



-INC CWELB805 



EXEC SQL 
INTO 

END-EXEC 

PERFORM 



FETCH 



BENEFITS AUTH 



Q000-CHECK-SQLCODE THRU 
Q000-CHECK-SQLCODE-EXIT 

TRUE 



SMB000 



EVALUATE 



WHEN ORA-SQL-SUCCESS FUL 

ADD 1 TO WS-BEN-FETCH-CNT 
SET BEN-AVAILABLE TO TRUE 
MOVE +0 TO 

MOVE WS-PROCESS-DATE TO 



BEN-LAST-CLAIM- VAL-AMT 

BEN-LAST-CLAIM-DT-TM 

BEN-LAST-REQUEST-DT-TM 



SET BEN-CLAIM-CONFIRM TO TRUE 
PERFORM B380- SELECT-BEN- DEF THRU 
B3 80 -SELECT-BEN- DEF-EXIT 
IF ORA-SQL-SUCCESSFUL 

COMPUTE WS-BEN-REM- VAL-AMT 

= BEN-REM-VAL-AMT * 100 
MOVE ZERO TO WS-REQ-TOT-AMT 

MOVE f B130 ' TO WORK- PARA 

PERFORM TRACE-IT 
PERFORM B130-GET-CLAIM-AMT THRU 
B130-GET-CLAIM-AMT-EXIT 
VARYING IDXR FROM 1 BY 1 

UNTIL IDXR > WS-MAX-REQ-NUM 

END-IF 



IF WS-REQ-TOT-AMT > ZERO 

COMPUTE WS-REQ-TOT-AMT-C3 - 
SUBTRACT WS-REQ-TOT-AMT-C3 
MOVE WS-REQ-TOT-AMT-C3 TO 
SET BEN-AVAILABLE TO TRUE 



WS-REQ-TOT-AMT / 100 
FROM BEN-REM-VAL-AMT 
BEN-LAST-CLAIM- VAL-AMT 



00068000 
00068100 
00068100 
00068100 
00068100 
00068100 

00034700 
00034800 
0003490% 
00035000 
00035100 
00035200 
00035300 
00035400 
00035500 
00038900 
00035600 
00036600 
00036700 
00036700 
00036700 
00036700 
00036700 
00036700 
00036700 
00036800 
00036900 
00041400 
00041400 
00037000 
00068100 
00068100 
00037100 
00037100 
00037300 
00037400 
00036900 
00038900 
00008300 
00008300 
00068100 
00068100 
00068100 



MOVE DATA FROM BEN- TO CLM- 

MOVE BEN-CUSTOMER- ID 

MOVE BEN-BENEFIT-TYPE 

MOVE BEN-SERIAL-NUM 

MOVE BEN-EFFECTIVE-DATE 

MOVE BEN-LAS T-AUTH-CDE 

MOVE BEN-MFG-SERIAL-NUM 

MOVE BEN-EXPIRATION-DATE 



TO CLM-CUSTOMER-ID 
TO CLM- BENE FIT-TYPE 
TO CLM-SERIAL-NUM 

TO CLM- EFFECTIVE- DATE 

TO CLM-AUTHORI ZATION-CDE 

TO CLM-MFG- SERIAL- NUM 

TO CLM-EXPI RATION- DATE 



000 
000 
000 
000 
000 
000 
000 
000 
000 
000 
000 
000 



49800 
49900 
50000 
50100 
50200 
50200 
50200 
50200 
50400 
50400 
50500 
50500 



MOVE BEN-LAST- CLAIM- VAL-AMT TO 
MOVE BEN-LAST- RETR- RE F-NUM TO 
MOVE WS-PROCESS-DATE TO 
SET CLM-CLAIM- CON FIRM TO TRUE 
PERFORM B150-CREATE-CLAIM-ROW THRU 
B150-CREATE-CLAIM-ROW-EXIT 

END-IF 



CLM-CLAIM- VAL-AMT00050 600 
CLM-RETR-REF-NUM 00050700 
CLM-REQUEST-DT-TM00036700 
00050800 
00024000 
00024000 



TO 
TO 



SMB000 



SMBOOO* 

SMBOOO* 

SMBOOO* 

SMB000 

SMB000 

SMB000 

SMB000 

SMB000 

SMBOOO 

SMB000 

SMBOOO 



IF WS-IN-PROCESS 
MOVE 'BENEFITS' 
MOVE 1 UPDATE AFTER CLMUPD* ' 
MOVE 1 B180 
PERFORM TRACE-IT 
SET BEN-AVAILABLE TO TRUE 
PERFORM Bl 80- UPDATE-BENEFIT THRU 
B18 0-UPDATE-BENEFIT-EXIT 

END-IF 



ORA- TABLE-ID 
ORA- FUNCTION-ID 
TO WORK-PARA 



WHEN ORA- SQL-END-OF- FETCH 
MOVE 'B100 EOF' 
PERFORM TRACE- IT 



TO WORK- PARA 



IF WS-BEN-FETCH-CNT > ZERO 

PERFORM Bl 90-CREATE-OVER-CLAIM THRU 
Bl 90-CREATE-OVER-CLAIM-EXIT 
IF WS-IN-PROCESS 

SET WS-PROCESS-SUCCESSFUL TO TRUE 
END-IF 
ELSE 

PERFORM B200-AP PLY-CREDIT THRU 
B200-APPLY-CREDIT-EXIT 

END-IF 



IF WS-IN-PROCESS 

SET WS-PROCESS-SUCCESSFUL 
END-IF 

WHEN OTHER 

MOVE 'B100OTHR' 
PERFORM TRACE-IT 
SET WS-DB-ERROR TO TRUE 
SET MLA-RC-FAILED-DB-IO TO 
END-EVALUATE 
END-PERFORM 



TO TRUE 



TO WORK- PARA 



TRUE 



00038900 

00068100 
00068100 
00068100 
00068100 
00068100 
00024000 
00024000 

00038900 
00039000 
00068100 
00068100 
00038900 
00024000 
00024000 
00024000 
00039100 
00039100 
00039100 
00024000 
00024000 
00024000 
00024000 
00024000 
00039100 
00039100 
00039100 
00038900 
00039000 
00068100 
00068100 
00039100 
00039100 
00039500 
00039500 



B100-PROCESS-CLAIMS-EXIT. 
EXIT. 



* VALIDATE THE PRODUCT/ PURSE FOR THIS BENEFIT. * 

* SUM CLAIM AGAINST THIS BENEFIT * 

B130-GET-CLAIM-AMT . 



MOVE , B130 t TO WORK- PARA 

IF EUB5-REQ-VAL-AMT (IDXR) > ZERO 



00040800 
00040900 



MOVE ZERO TO WS-BIN-2N 

MOVE EUB5- PURSE-CLASS- ID (IDXR) TO WS-B2-LO 
MOVE WS-BIN-2N TO IDXD 

IF BND- BENE FIT- ALLOWED (IDXD) 
COMPUTE WS-EUB5-REQ-VAL-AMT 

= EUB5-REQ-VAL-AMT (IDXR) 



/ 100 



EVALUATE TRUE 
WHEN WS-BEN-REM-VAL-AMT <= EUB5-REQ-VAL-AMT (IDXR) 
ADD WS-BEN-REM-VAL-AMT TO WS-REQ-TOT-AMT 
ADD WS-EUB5-REQ-VAL-AMT TO BEN- LAST -CLAIM- VAL-AMT 
SUBTRACT WS-BEN-REM-VAL-AMT 

FROM EUB5-REQ- VAL-AMT (IDXR) 
MOVE ZERO TO WS-BEN-REM-VAL-AMT 

WHEN OTHER 

ADD EUB5-REQ- VAL-AMT (IDXR) TO WS-REQ-TOT-AMT 
ADD WS-EUB5-REQ- VAL-AMT 

TO BEN-LAST-CLAIM- VAL-AMT 
SUBTRACT WS-EUB5-REQ- VAL-AMT 

FROM WS-BEN-REM-VAL-AMT 
MOVE ZERO TO EUB5-REQ- VAL-AMT (IDXR) 

END-EVALUATE 
END-IF 
END-IF 



00041000 
00041100 
00041200 
00041300 
00041500 
00041600 
00041700 
00041800 
00041900 
00042000 
00042200 
00042300 
00042400 
00042500 
00042600 
00042700 
00042800 
00043100 
00043200 
00043400 
00043300 
00043500 
00043600 
00043700 
00044300 



B130-GET-CLAIM-AMT-EXIT . 
EXIT. 



************************************ 

VALIDATE THE PRODUCT/PURSE FOR THIS BENEFIT. * 

SUM CREDIT TO BE APPLIED TO THIS BENEFIT * 
***************************************************************** 

Bl 3 5 -GET-CREDIT- AMT . 



MOVE ' B135' 



TO WORK- PARA 



MOVE ZERO TO 
MOVE EUB5- PURSE-CLASS- ID (IDXR) TO 
MOVE WS-BIN-2N TO 
IF BND-BENEFIT -ALLOWED (IDXD) 
COMPUTE WS-EUB5-REQ- VAL-AMT 

= EUB5-REQ- VAL-AMT 



WS-BIN-2N 
WS-B2-LO 
IDXD 



(IDXR) / 100 



EVALUATE TRUE 
WHEN WS-CLM-REM-VAL-AMT <= EUB5-REQ- VAL-AMT (IDXR) 
ADD WS-CLM-REM-VAL-AMT TO WS-REQ-TOT-AMT 
SUBTRACT WS-CLM-REM-VAL-AMT 

FROM EUB5-REQ- VAL-AMT (IDXR) 
MOVE ZERO TO WS-CLM-REM-VAL-AMT 

WHEN OTHER 

ADD EUB5-REQ- VAL-AMT (IDXR) TO WS-REQ-TOT-AMT 
SUBTRACT WS-EUB5-REQ- VAL-AMT 

FROM WS-CLM-REM-VAL-AMT 
MOVE ZERO TO EUB5-REQ- VAL-AMT (IDXR) 

END- EVALUATE 



00040800 
00041000 
00041100 
00041200 
00041300 
00041500 
00041600 
00041700 
00041800 
00041900 
00042000 
00042300 
00042400 
00042500 
00042600 
00042700 
00042800 
00043400 
00043300 
00043500 
00043600 



END-IF 



00043700 



Bl 3 5 -GET-CREDIT- AMT -EXI T . 
EXIT. 

* CREATE A CLAIM ROW FOR THE BENEFITS USFED * 
B150-CREATE-CLAIM-ROW. 



MOVE 'B150' 
MOVE ' CLAIMS' 
MOVE ' INSERT ' 
PERFORM TRACE-IT 



TO WORK- PARA 
TO ORA-TABLE- I D 
TO ORA-FUNCTION-ID 



THEN INSERT THE CLAIM ROW INTO THE CLAIM TABLE 
EXEC SQL INSERT 

INTO MCHECK. CLAIMS 



( 



-INC CWELB8 10 



) 

VALUES 
( 



-INC CWELB815 



) 

END-EXEC 

PERFORM Q000-CHECK-SQLCODE THRU 
Q000-CHECK-SQLCODE-EXIT 



00068100 
00068100 
00068100 
00051000 
00051100 
00051200 
00051300 
0005140% 
0005140% 
00051800 
00051600 
0005140% 
0005170% 
00051800 
00051900 
00052000 
00052100 
00052200 



B150-CREATE-CLAIM-ROW-EXIT . 
EXIT. 

* UPDATE THE BENEFIT ROW BEING PROCESSED * 



Bl 80- UPDATE -BENEFIT . 



MOVE ' B180' 



TO WORK- PARA 



EXEC SQL UPDATE MCHECK . BENEFITS 



SET 

-INC CWELB808 

WHERE 
AND 
AND 
AND 
END-EXEC 

PERFORM 



SERIAL_NUM 
CUSTOMER_ID 
BENEFIT_TYPE 
EFFECTIVE DATE 



BEN-SERIAL-NUM 
BEN-CUSTOMER-ID 
BEN-BENEFIT-TYPE 
BEN-EFFECTIVE-DATE 



Q000-CHECK-SQLCODE THRU 
Q000-CHECK-SQLCODE-EXIT 



IF NOT ORA-SQL-SUCCESSFUL 
SET WS-DB-ERROR TO TRUE 
MOVE 'BENEFITS' 
MOVE ' UPDATE ' 
MOVE +1 



TO ORA-TABLE- ID 
TO ORA-FUNCTION-ID 
TO SLC-MESSAGE-LENGTH 



00036600 
00036600 
0003660% 
00036600 
00036600 
00036600 
00036600 
00036600 
00038900 
00035200 
00035300 
00038900 
00035600 
00039100 
00039100 
00039100 



MOVE SPACES 



TO SLF-MES SAGE- VALUE 



STRING 



B506: ' 

EUB5 NOT PROCESSED - DB ERROR 1 



SQLCODE : ' 
MESSAGE : ' 
PARA: ' 
TABLE : ' 
FUNCTION: ■ 
EUB5 DATA: ' 
BENE ROW : * 
DELIMITED BY SIZE 

INTO SLF-MES SAGE- VALUE 
WITH POINTER SLC-MES SAGE-LENGTH 
PERFORM PROCABEC- LINK-TO-LOGGER 

THRU PROCABEC- LINK-TO-LOGGER-EXIT 

END-IF 



ORA-SQLCODE-DISP-4 
SQLERRMC 
WORK- PARA 
ORA- TABLE- ID 
ORA-FUNCTION-ID 
EUB5-DATA 
BENEFITS-ROW 



B180-UPDATE-BENEFIT-EXIT. 
EXIT . 

CREATE A CLAIM FOR EUB5 CLAIM AMOUNTS THAT ARE GREATER THAN 
THE VALUE AVAILABLE ON THE BENEFIT. 

B 1 90 -CREATE-OVER- CLAIM . 



MOVE 'B190' 



TO WORK- PARA 



MOVE ZERO TO WS-OVER-CLAIM-AMT 

PERFORM VARYING IDXR FROM 1 BY 1 

UNTIL IDXR > WS-MAX-REQ-NUM 
IF EUB5-REQ-VAL-AMT (IDXR) > ZERO 

ADD EUB5-REQ-VAL-AMT (IDXR) TO WS-OVER-CLAIM-AMT 
END-IF 
END-PERFORM 

IF WS-OVER-CLAIM-AMT > ZERO 



MOVE DATA TO CLAIMS 

MOVE BEN-CUSTOMER- ID 
MOVE BEN-BENEFIT-TYPE 
MOVE BEN-SERIAL-NUM 
MOVE BEN-EFFECTIVE-DATE 

MOVE BEN- LAST -AUTH-CDE 

ADD 1 TO WS-AC-GMT 
MOVE WS-AUTHORIZATION-CDE 

MOVE BEN-MFG-SERIAL-NUM 

MOVE BEN-EXPIRATION- DATE 



TO CLM-CUSTOMER-ID 

TO CLM- BENEFIT-TYPE 

TO CLM-SERIAL-NUM 

TO CLM-EFFECTIVE-DATE 

TO WS-AUTHORIZATION-CDE 

TO CLM-AUTHORIZATION-CDE 

TO CLM-MFG-SERIAL-NUM 

TO CLM- EX PI RAT I ON -DATE 



COMPUTE WS -OVER-CLAIM- AMT-C3 

(WS-OVER-CLAIM-AMT / 100) 
MOVE WS-OVER-CLAIM-AMT-C3 TO CLM-CLAIM-VAL-AMT 

MOVE BEN-LAST-RETR-REF-NUM TO CLM-RETR-REF-NUM 



SET CLM- CLAIM-CONFIRM TO TRUE 

MOVE WS- PROCESS-DATE TO CLM- REQUEST -DT-TM 



00050800 
00050900 



PERFORM B150-CREATE-CLAIM-ROW THRU 
B150-CREATE-CLAIM-ROW-EXIT 

END-IF 

B 190 -CREATE-OVER- CLAIM- EXIT . 
EXIT. 



00024000 
00024000 
00024000 



******************************************************************qqq44qqq 

* APPLIES A CREDIT TO THE BENEFIT - IF NEEDED *00044900 
*********************************** 



B200-APPLY-CREDIT . 

MOVE ' B200 *• 

MOVE ' CLAIMS ' 

MOVE 'OPECUR CLAIMS_AUTH * 

PERFORM TRACE-IT 



TO WORK- PARA 

TO ORA-TABLE- I D 
TO ORA-FUNCTION-ID 



SET WS-APPLY-CREDIT-CLAIM TO TRUE 



00045100 
00045200 
00075300 
00045200 
00068100 
00068100 
00068100 

00008100 



OPEN CLAIMS_AUTH CURSOR 
MOVE EUB5- SERIAL- NUM 
MOVE WS-SN-HI-2 
MOVE WS-SN-LO-4 
MOVE WS-SERIAL-NUM-X15 
MOVE EUB5-AUTH-CDE 



TO 


WS 


-SERIAL-NUM 


TO 


WS 


-OSN-HI-5 


TO 


WS 


-OSN-LO-10 


TO 


WS 


-ORA- SERIAL-NUM 


TO 


WS 


-AUTH-CDE 



00032800 
00032900 
00032900 



EXEC SQL 

OPEN 
END-EXEC 



CLAIMS AUTH 



PERFORM Q000-CHECK-SQLCODE THRU 
Q000-CHECK-SQLCODE-EXIT 



IF WS-DB-ERROR 

SET MLA-RC-FAILED-DB-IO TO TRUE 

GO TO B100-PROCESS-CLAIMS-EXIT 
END-IF 

MOVE 'CLAIMS ' TO 
MOVE ' FTCH CLAIMS_AUTH T TO 
PERFORM UNTIL WS-PROCESS-COMPLETE 

MOVE ' B2 00FTCH f TO WORK- PARA 

PERFORM TRACE- IT 



ORA-TABLE- ID 
ORA-FUNCTION-ID 



-INC CWELB8 15 



EXEC SQL 
INTO 

END-EXEC 

PERFORM 



FETCH CLAIMS AUTH 



Q000-CHECK-SQLCODE THRU 
Q000-CHECK-SQLCODE-EXIT 



EVALUATE TRUE 



00068000 
00068100 
00068100 
00068100 
00068100 
00068100 

00034700 
00034800 
0003490% 
00035000 
00035100 
00035200 
00035300 
00035400 
00035500 











00038900 


WHEN ORA-SQL-SUCCESSFUL 






00035600 










00068000 


MOVE ' CLAIMS ' 


TO 


ORA-TABLE-ID 


00068100 


MOVE 1 FTCH 


CLAIMS AUTH ' 


TO 


ORA-FUNCTION-ID 


00068100 


MOVE ' B200FCLM 1 


TO 


WORK- PARA 


00068100 


PERFORM 


TRACE-IT 






00068100 
00036600 


ADD 


1 TO WS-CLM-FETCH 


-CNT 




00036700 


MOVE 


CLM-CUSTOMER-ID 


TO 


BEN-CUSTOMER-ID 


00036700 


MOVE 


CLM- BENEFIT-TYPE 


TO 


BEN-BENEFIT-TYPE 


00036700 


MOVE 


CLM-SERIAL-NUM 


TO 


BEN-SERIAL-NUM 


00036700 


MOVE 


CLM-EFFECTI VE-DATE 


TO 


BEN-EFFECTIVE-DATE 


00036700 


MOVE 


CLM-AUTHORI ZATION- 


CDE TO 


WS-SAVE-AUTH-CDE 


00007300 


MOVE 


CLM-RETR-REF-NUM 


TO 


WS-SAVE-RETR-REF-NUM 


00050700 
00036600 


EXEC 


SQL SELECT 









-INC CWELB800 
-INC CWELB805 



-INC CWELB8 00 



INTO 

FROM MCHECK . BENEFITS 
WHERE SERIAL^NUM 
AND CUSTOMER^ID 
AND BENEFITJTYPE 
AND EFFECT I VE_DATE 

FOR UPDATE OF 

END-EXEC 



PERFORM Q000-CHECK-SQLCODE THRU 
Q000-CHECK-SQLCODE-EXIT 

TRUE 



BEN-SERIAL-NUM 
BEN-CUSTOMER-ID 
BEN-BENEFIT-TYPE 
BEN-EFFECTIVE- DATE 



EVALUATE 



WHEN ORA-SQL-SUCCESSFUL 

PERFORM B250-UPD-BEN-INS-CLM THRU 
B250-UPD-BEN-INS-CLM-EXIT 



WHEN OTHER 

SET MLA-RC-FAILED-DB-IO TO 
SET WS-DB-ERROR TO TRUE 

MOVE +1 
MOVE SPACES 
STRING 



TRUE 



TO SLC-MES SAGE-LENGTH 
TO SLF-MES SAGE- VALUE 



ORA-SQLCODE-DISP-4 
WORK- PARA 
SQLERRMC 
ORA-TABLE-ID 
ORA-FUNCTION-ID 



B507: ' 
SQLCODE : ' 
PARA: ' 
MESSAGE : ' 
TABLE : ' 
FUNCTION: ' 
DELIMITED BY SIZE 

INTO SLF-MESSAGE- VALUE 
WITH POINTER SLC-MES SAGE-LENGTH 
PERFORM PROCABEC-LINK-TO-LOGGER 

THRU PROCABEC-LINK-TO-LOGGER-EXIT 

END-EVALUATE 



00017200 

% 

00036600 
00035200 
00035300 
00035400 
00035500 
00038900 
00035600 
00035600 
00035600 
00038900 
00035600 



00074400 
00074700 
00074800 
00074900 
00075000 
00075100 
00075200 
00075300 
00075300 
00075400 
00075500 
00075600 
00075700 
00075800 
00036600 
00035500 



WHEN ORA- SQL- END-OF- FETCH 

SET WS-PROCESS-SUCCESSFUL TO TRUE 



MOVE ' CLAIMS ' TO 

MOVE 'EOF CLAIMS_AUTH ' TO 

MOVE 'B200 EOF' TO 

PERFORM TRACE-IT 



ORA-TABLE-I D 
ORA-FUNCTION-ID 
WORK- PARA 



WHEN OTHER 

SET MLA-RC-FAILED-DB-IO TO TRUE 
SET WS-DB-ERROR TO TRUE 

END- EVALUATE 

END-PERFORM 



00038900 
00035600 

00068000 
00068100 
00068100 
00068100 
00068100 
00038900 
00035600 



00038900 
00035500 
00036600 
00068100 



B200-APPLY-CREDIT-EXIT. 
EXIT. 



00045100 



it********************************** 

* APPLIES CREDIT TO BENEFIT AMOUNT REMAINING 

* INSERTS A CLAIM FOR THE INCREASE ON THE BENEFITS ROW 

B2 50-UPD-BEN-INS-CLM . 



TO WORK- PARA 



MOVE 'B250 *' 

PERFORM B3 8 0- SELECT-BEN- DEF THRU 
B3 8 0- SELECT-BEN- DEF-EXIT 



IF ORA-SQL-SUCCESSFUL 

SET WS-APPLY-CREDIT-CLAIM TO TRUE 
COMPUTE WS-CLM-REM-VAL-AMT 

= CLM- CLAIM- VAL-AMT 
MOVE ZERO TO WS-REQ-TOT-AMT 



100 



TO WORK- PARA 



MOVE 'B250 
PERFORM TRACE- IT 
PERFORM B135-GET-CREDIT-AMT THRU 
B135-GET-CREDIT-AMT-EXIT 
VARY I NG I DX R FROM 1 BY 1 

UNTIL IDXR > WS-MAX-REQ-NUM 



IF WS-REQ-TOT-AMT > ZERO 

COMPUTE WS-REQ-TOT-AMT-C3 = WS-REQ-TOT-AMT / 100 
COMPUTE WS-DIFF-AMT-C3 - CLM-CLAIM- VAL-AMT 



IF WS-DI FF-AMT-C3 NOT = 
COMPUTE BEN- REM- VAL-AMT 



- WS-REQ-TOT-AMT-C3 
ZERO 

= BEN-REM-VAL-AMT 
+ WS-DIFF-AMT-C3 



****00044800 
*00044900 
*00044900 

****00045000 
00045100 
00045200 
00075300 
00045200 
00036700 
00036800 
00045200 
00036900 
00008100 
00041400 
00041400 
00037000 
00068100 
00068100 
00037100 
00037100 
00037300 
00037400 
00038900 
00008300 
00008300 
00068100 
00068100 
00068100 
00068100 
00068100 



MOVE DATA FROM BEN- TO CLM- 
MOVE BEN-CUSTOMER- ID 
MOVE BEN-BENEFIT-TYPE 
MOVE BEN-SERIAL-NUM 
MOVE BEN-EFFECTIVE-DATE 

TO 



00049800 

TO CLM-CUSTOMER-ID 0004 9900 
TO CLM-BENEFIT-TYPE 00050000 ' 
TO CLM-SERIAL-NUM 00050100 

00050200 

CLM- EFFECTIVE -DATE 00050200 



MOVE WS-SAVE-AUTH-CDE 

ADD 1 TO WS-AC-GMT 
MOVE WS-AUTHORIZATION-CDE 

MOVE BEN-MFG- SERIAL -NUM 

MOVE BEN-EXPIRATION- DATE 



TO WS-AUTHORIZATION-CDE 

TO CLM-AUTHORI ZATION-CDE 
TO CLM-MFG-SERIAL-NUM 



TO CLM-EXPI RAT ION- DATE 
MOVE ZERO TO CLM-CLAIM-VAL-AMT 

SUBTRACT WS-DIFF-AMT-C3 FROM CLM-CLAIM-VAL-AMT 
MOVE WS-PROCESS-DATE TO CLM-REQUEST-DT-TM 

MOVE WS-SAVE-RETR-REF-NUM TO CLM-RETR-REF-NUM 
SET CLM-CLAIM- CREDIT TO TRUE 
PERFORM B150-CREATE-CLAIM-ROW THRU 
B150-CREATE-CLAIM-ROW-EXIT 

END-IF 



TO ORA-TABLE-ID 
TO ORA-FUNCTION-ID 
TO WORK- PARA 



IF WS-IN-PROCESS 
MOVE 'BENEFITS' 
MOVE 'UPD AFT CLM CREDIT*' 
MOVE 'B180 
PERFORM TRACE-IT 
IF BEN-AVAILABLE 

MOVE WS-REQ-TOT-AMT-C3 

TO BEN- LAST-CLAIM- VAL-AMT 
MOVE WS-PROCESS-DATE TO BEN- LAST- CLAIM- DT-TM 

BEN-LAST-REQUEST-DT-TM 

MOVE WS-SAVE-RETR-REF-NUM 

TO BEN-LAST-RETR-REF-NUM 
SET BEN-CLAIM-CREDIT TO TRUE 
END-IF 

PERFORM Bl 80 -UPDATE-BENEFIT THRU 
Bl 80 -UPDATE-BENEFIT- EXIT 

END-IF 
END-IF 
ELSE 

SET MLA-RC-FAILED-DB-IO TO TRUE 
SET WS-DB-ERROR TO TRUE 
END-IF 



00050200 
00050200 
00050200 
00050200 
00050200 
00050400 
00050400 
00050500 
00050500 
00068100 
00068100 
00036700 
00050700 
00050800 
00024000 
00024000 

00038900 

00068100 
00068100 
00068100 
00068100 
00068100 
00068100 
00068100 
00036700 
00036700 
00050700 
00050700 
00050800 
00068100 
00068100 
00024000 
00024000 



B250-UPD-BEN-INS-CLM-EXIT . 
EXIT. 



00045100 



SELECTS ROW FROM BENEFIT DEFINITION TABLES 



B380-SELECT-BEN-DEF . 



*00044900 
00045000 



MOVE 'BEN DEF* ' 
MOVE ' SELECT ' 

EXEC SQL SELECT 
-INC CWELB830 

INTO 

-INC CWELB835 



TO ORA-TABLE-ID 
TO ORA-FUNCTION-ID 



00045100 
00045200 
00075300 
00075300 
00045400 
00045500 
0004560% 
00045700 
0004580% 



FROM MCHECK. BENEFITS_DEFINITION 
WHERE BENEFIT_TYPE = : BEN-BENEFIT-TYPE 
END-EXEC 

PERFORM Q000-CHECK-SQLCODE THRU 
Q000-CHECK-SQLCODE-EXIT 



IF NOT ORA-SQL-SUCCESSFUL 
MOVE +1 
MOVE SPACES 



STRING 



B507: ' 
SQLCODE : ' 
MESSAGE : 1 
TABLE : ' 
FUNCTION; 
PARA: ' 



TO SLC-MES SAGE- LENGTH 
TO SLF-MES SAGE- VALUE 

ORA-SQLCODE-DISP-4 
SQLERRMC 
ORA-TABLE-ID 
ORA- FUNCTION- ID 
WORK- PARA 



DELIMITED BY SIZE 

INTO SLF-MES SAGE- VALUE 
WITH POINTER SLC-MES SAGE- LENGTH 
PERFORM PROCABEC-L INK- TO- LOGGER 

THRU PROCABEC-L INK- TO- LOGGER- EX IT 



TO WORK- PARA 



END-IF 

MOVE 'B380' 

B38 O-SELECT-BEN-DEF-EXIT . 
EXIT. 



************************^***+*****************************^ 

* CLEARS EUB2 REQUEST AMOUNTS 

* PERFORMS ROLLBACK OF ALL DATABASE ACTIVITY 

************************************************************ 
B530-ROLLBACK- TABLES . 



TO WORK- PARA 



MOVE 'B530' 

* ROLLBACK THE DATABASE PROCESSING 
EXEC SQL ROLLBACK 

WORK 
END-EXEC 

PERFORM Q000-CHECK-SQLCODE THRU 
Q000-CHECK-SQLCODE-EXIT 

B530-ROLLBACK-TABLES-EXIT . 
EXIT. 



************************************************************ 

* PERFORMS COMMIT OF ALL DATABASE ACTIVITY 
************************************ 

B5 4 0-COMMIT-DB- ACTIVITY . 



MOVE 'B54 0' 

* ROLLBACK THE DATABASE PROCESSING 
EXEC SQL COMMIT 

WORK 
END-EXEC 



TO WORK- PARA 



00045900 
00046000 
00046100 
00046200 
00046300 
00046400 
00074400 
00074500 
00074700 
00074800 
00074900 
00075000 
00075200 
00075300 
00075300 
00075100 
00075400 
00075500 
00075600 
00075700 
00075800 
00074500 
00045300 
00046500 
00046600 
00046700 
00056400 
******00056500 
*00056600 
*00056700 

******00056800 
00056900 

00057000 
00057100 
00057200 
00056500 
00037300 
00037400 
00037300 
00033300 
00033400 
00033500 
00056100 
00056900 
00056300 
00056400 

******00056500 
*00056700 

******00056800 
00056900 
00057000 
00057100 
00057200 
00056500 
00037300 
00037400 
00037300 



PERFORM Q000-CHECK-SQLCODE THRU 
Q000-CHECK-SQLCODE-EXIT 

B54 0 -COMMIT- DB- ACTIVITY-EX IT . 
EXIT. 



00033300 
00033400 
00033500 
00056100 
00056900 
00056300 



* EDITS FOR: * 

* 1. VALID MESSAGE ID * 

E100-EDIT-EUB5-MSG. 



TO ORA- TABLE- ID 
TO ORA-FUNCTION-ID 
TO WORK- PARA 



MOVE 

MOVE ' EDIT EUB5 ' 
MOVE ' E100' 
PERFORM TRACE- IT 

* IS THIS AN EUB5 MESSAGE ???? 

IF MLA- INPUT-TRANS- ID NOT = 'EUB5' 

SET MLA-RC-BAD-MLA-TRANS- I D TO TRUE 
MOVE +1 TO SLC-MES SAGE-LENGTH 

MOVE SPACES TO SLF-MES SAGE- VALUE 

STRING 'B505: 1 

MLA- INPUT-TRANS- ID ' <= INVALID TRANS ID! ' 
1 MESSAGE DATA: ' EUB5-DATA 
DELIMITED BY SIZE 

INTO SLF-MESS AGE- VALUE 
WITH POINTER SLC -MESSAGE-LENGTH 
PERFORM PROCABEC- LINK-TO-LOGGER 

THRU PROCABEC- LINK-TO-LOGGER-EXIT 
SET WS-EDIT-ERROR TO TRUE 
GO TO E100 -EDI T-EUB 5 -MSG-EXIT 
END-IF 

***********************************^ 

* DETERMINE NUMBER OF BENEFIT REQUESTS CONTAINED IN THE EUB5 

* MESSAGE. 

COMPUTE WS-MAX-REQ-NUM = 

( (MLA-INPUT-DATA-LENGTH - 69} / 5) 

IF WS-MAX-REQ-NUM > WS-VALI D-MAX-REQ-NUM 
SET MLA-RC-BAD-MSG-LEN TO TRUE 



MOVE WS-MAX-REQ-NUM 
MOVE WS-VALI D-MAX-REQ-NUM 
MOVE +1 
MOVE SPACES 



TO WS-COMP-DISP-4 
TO WS-COMP-DISP-4 A 
TO SLC-MES SAGE-LENGTH 
TO SLF-MES SAGE- VALUE 



STRING 



B504: ' 
MAX REQS EXCEEDED-' 
REQUEST COUNT: ' 
EXCEEDS MAXIMUM ALLOWED: 1 
EUB5: ' EUB5-DATA 
DELIMITED BY SIZE 

INTO SLF-MES SAGE- VALUE 



WS-COMP-DISP-4 
WS-COMP-DISP-4 A 



00075300 
00075300 



*****00067600 
*00067700 

*****00067800 
00067900 
00068000 
00068000 
00068100 
00068200 
00068300 
00068500 
00068600 
00068700 
00068800 
00068900 
00069000 
00069100 
00069200 
00069300 
00069400 
00069500 

*****00069600 
*00069700 
*00069800 

*****00069900 
00070000 
00070100 
00070400 
00070500 
00068000 
00070600 
00070700 
00070800 
00070900 
00071000 
00071100 
00071200 
00071300 
00071400 
00071500 
00071600 



WITH POINTER SLC-MES SAGE-LENGTH 
PERFORM PROCABEC- LINK-TO-LOGGER 

THRU PROCABEC- LINK-TO-LOGGER-EX IT 
SET WS -EDIT- ERROR TO TRUE 
GO TO E100-EDIT-EUB5-MSG-EXIT 
END-IF 

E100-EDIT-EUB5-MSG-EXIT . 
EXIT. 



* CHECKS FOR DATABASE ERRORS 

* IF DATABASE ERROR 

* LOGS THE ERROR 

Q000-CHECK-SQLCODE . 



MOVE SQLCODE TO ORA-NAMED-SQLCODE 

ORA-SQLCODE-DISP-4 

EVALUATE TRUE 

WHEN ORA-SQL-SUCCESSFUL 
WHEN ORA-SQL-ROW-NOT-FOUND 
CONTINUE 



DATABASE ERROR 



WHEN OTHER 

SET WS-DB-ERROR 
MOVE +1 
MOVE SPACES 
STRING 'B502: ' 

SQLCODE 
PARA: ' 
MESSAGE 
PROGRAM 
DELIMITED 
INTO 

WITH POINTER 
PERFORM PROCABEC- 
THRU PROCABEC- 
END-EVALUATE 



TO TRUE 



TO SLC-MESS AGE- LENGTH 
TO SLF-MESS AGE- VALUE 



: ' ORA-SQLCODE-DISP-4 

WORK- PARA 
: ' SQLERRMC 
' WS- PROGRAM- ID 
BY SIZE 

SLF-MESS AGE -VALUE 
SLC-MES SAGE- LENGTH 
LINK-TO-LOGGER 
LINK-TO-LOGGER-EXIT 



Q000-CHECK-SQLCODE-EXIT . 
EXIT. 



TRACE-IT. 

MOVE +1 
MOVE SPACES 
STRING 

WORK PARA: 



BENEFITS : ' 
CLAIMS : ' 
TABLE : ' 
FUCNTION: ' 
DELIMITED BY SIZE 



TO SLC-MES SAGE-LENGTH 
TO SLF-MES SAGE- VALUE 

WORK- PARA 
BENEFITS-ROW 
CLAIMS -ROW 
ORA-TABLE-ID 
ORA-FUNCTION-ID 



INTO SLF-MESS AGE- VALUE 



WITH POINTER SLC-MES SAGE-LENGTH 00068900 
PERFORM PROCABEC -LINK-TO- LOGGER 00069000 
THRU PROCABEC -LINK-TO- LOGGER-EX IT 00069100 

IF PARA-NDX > 999 

ADD 1 TO TRACE-CYCLE 

SET PARA-NDX TO 1 

ELSE 

SET PARA-NDX UP BY 1 
END-IF . 

MOVE WORK- PARA TO PARA- ID (1) 



TRACE-IT-EXIT. 
EXIT. 

/ 

-INC CWPL9090 
/ 

-INC CWXL9920 
/ 

-INC CWXL9900 
□ 



APPENDIX F 



IDENTIFICATION DIVISION. 
***************************************************************** 

PROGRAM- 1 D . CWUCB2 0 0 . 
AUTHOR . CUBIC-CTS . 

INSTALLATION . 

DATE-WRITTEN. NOVEMBER, 1999. 
DATE-COMPILED. 

**************************************************************** 

PROGRAM NAME : BENEFITS RESPONSE (EUB2) 
PROGRAM ID : CWUCB200. 

SYSTEM: 9121-490, MVS/ESA, CICS, COBOL II, VSAM. 
PROJECT: 170-2719, ELECTRONIC BENEFITS DISTRIBUTION SYSTEM 

ON-LINE MONITORING CONTROL. 



DESC: THIS PROGRAM WILL BE USED TO TRANSMIT AN EUB2 

TRANSACTION TO REMOTE UNITS. 

AN EUB2 TRANSACTION IS IN RESPONSE TO AN EUB1 BENEFITS 
AUTHORIZATION REQUEST. IF THIS RESPONSE FUNCTION 
FAILS TO PASS THE MESSAGE DATA TO OTM FOR PROCESSING 
THEN REVERSE THE MESSAGE BY STARTING EFB2 TRANSACTION. 

INPUTS: MESSAGE LINKAGE AREA (PASS-AREA) 

OUTPUTS : 

ERRORS: (RETURN CODES PASSED TO CWAC5300 IN 1 MLA- RETURN-CODE 1 

RETURN CODE REASON 



0 MESSAGE SENT SUCCESSFULLY 

3 NO COMMAREA PASSED 

REVISION HISTORY : 
**************************************************************** 

11/11/99 SMBOOO RONO INITIAL PROGRAM 
**************************************************************** 

EJECT 

ENVIRONMENT DIVISION. 
DATA DIVISION. 
WORKING-STORAGE SECTION. 

**************************************************************** 

SET WS-PROGRAM-ID HERE 
**************************************************************** 

01 WS-WORKAREA. 

05 WS-PROGRAM-ID PIC X(08) VALUE 'CWUCB200'. 

05 FILLER PIC X(13) VALUE ' COMPILED ON: 1 . 

05 WS-WHEN-COMPILED PIC X(16). 

*********************************** 

**** THE 01 FOLLOWING IS FOR USE IN DEBUGGING ONLY ********* 
**************************************************************** 

01 TRACE -AREA. 

05 FILLER PIC X(16) VALUE f ***TRACE AREA***'. 



05 WORK- PARA 

05 TRACE-CYCLE 

05 TRACE-CTR 

05 WS-SUB1 

05 FILLER 

05 PARA-ID 



PIC 
PIC 
PIC 
PIC 
PIC 



X(08) . 

9(5) 

9(5) 
9(05) 

XX VALUE 



VALUE ZERO . 
VALUE ZERO. 
VALUE ZERO. 



OCCURS 40 TIMES PIC X(08) 



******************************************************** 



01 WS-PROCESS-AREA. 
COPY CWWL008 0. 

/ 

0 1 SK-CI CS- REFORMAT-AREA . 
COPY CWWL90 90. 

/ 

01 STOP- PROCESS ING-COMMAREA . 
COPY CWLL5800. 

/ 

01 MESSAGE- ROUTER- LINKAGE . 
COPY CWLL3300. 

/ 

01 SYSTEM-LOGGER-COMMAREA . 
COPY CWLL3100. 

01 COMMON-DEFINITIONS . 
COPY CWWL0020. 

***********************************+******************** 

LINKAGE SECTION. 
******************************************************** 

01 DFHCOMMAREA. 

03 MESSAGE-LINK-AREA. 
COPY CWLL5300. 



******************************************************** 

PROCEDURE DIVISION. 
********************************** 

Al 00 -MAIN-ROUTINE . 

MOVE 'A100* TO WORK-PARA. 

MOVE WHEN-COMPILED TO WS-WHEN-COMPILED . 
INITIALIZE MESSAGE-ROUTER-LINKAGE. 

EXEC CICS HANDLE ABEND 

LABEL ( PROCABEC-ABEND-HANDLER) 

END-EXEC. 

IF EIBCALEN > 0 

CONTINUE 
ELSE 

SET MACK-BLANK TO TRUE 

SET MLA-RC-STOP-PROCESS TO TRUE 

MOVE +1 TO SLC -MESSAGE- LENGTH 

STRING 'B201: PROGRAM ' WS -PROGRAM- I D 
\ MESSAGE 1 M LA-TRANS- ID 
' WAS NOT SENT: NO COMMAREA WAS PASSED' 
DELIMITED BY SIZE INTO SLF-MES SAGE- VALUE 



WITH POINTER SLC-MESS AGE-LENGTH 
END-STRING 

PERFORM PROCABEC-L INK-TO- LOGGER 

THRU PROCABEC-L INK-TO- LOGGER- EX IT 
EXEC CICS RETURN END-EXEC 
END-IF. 

*****************+*******+*****+***^ 
THIS PROGRAM ACTS AS A PASS THROUGH FOR THE EUB2 MESSAGE, IT 1 
ONLY FUNCTION IS TO SATISFY THE INTERNAL AFC ARCHITECTURE. SO 
LETS MOVE THE EUB2 MESSAGE TO THE MLA OUTPUT AND PASS IT ON. 

SET MLA-RC-GOOD TO TRUE 

SET MACK-BLANK TO TRUE 

MOVE MLA- IN PUT -TRANSACT I ON TO MLA-OUT PUT-TRANSACTION 
MOVE MLA- INPUT-MESSAGE -ID TO MLA-OUTPUT-MESSAGE- ID 

COMPUTE MLA-RETURN-TRANS-LEN = 

MLA-OUT PUT- DATA-LENGTH 
+ LENGTH OF MLA-OUTPUT-HEADER . 

A100-END-PROGRAM. 

THIS ROUTINE IS PROCESSED TO TRANSFER CONTROL TO THE OUTPUT 
TRANSACTION MONITOR (OTM) 

MOVE 'A100 END 1 TO WORK- PARA. 

MOVE +1 TO SLC-MESS AGE-LENGTH 

MOVE SPACES TO SLF-MES SAGE-VALUE 

STRING 'B210: * 

' READY TO START OTM 1 

1 PARA: ' WORK- PARA 

' MLA INPUT MSG: ' MLA- INPUT-TRANSACTION 
DELIMITED BY SIZE 

INTO SLF-MES SAGE- VALUE 
WITH POINTER SLC-MES SAGE- LENGTH 
PERFORM PROCABEC-L INK-TO- LOGGER 

THRU PROCABEC-L INK-TO-LOGGER- EX IT 

SET CD-OTM TO TRUE. 

EXEC CICS XCTL 

PROGRAM (CD-NAMED- PGM) 

COMMAREA ( MESSAGE -LINK- AREA) 

LENGTH (LENGTH OF MESSAGE-LINK- AREA) 

RESP (WS-RESP) 
END-EXEC. 

IF WE FAIL THEN REVERSE THE MESSAGE * 

IF WS-RESP NOT = DFHRESP (NORMAL) 
EXEC CICS START TRANSI D ( ' EFB2 1 ) 

FROM (MESSAGE-LINK- AREA) 
RESP (WS-RESP) 

END-EXEC 

IF WS-RESP NOT = DFHRESP (NORMAL) 
MOVE WS-RESP TO WS-RESP-D 
MOVE +1 TO SLC-MES SAGE-LENGTH 

STRING 'B201: 1 



1 START OF THE BENEFIT REVERSAL PROG. (EFB2) * 
1 FAILED WHILE ATTEMPTING TO REVERSE A MESSAGE.' 
' RESP = ' WS-RESP-D 
' THE MESSAGE WAS NOT REVERSED! ' 
DELIMITED BY SIZE INTO SLF-MES SAGE- VALUE 
WITH POINTER SLC-MES SAGE- LENGTH 



END-STRING 

PERFORM PROCABEC-L INK-TO-LOGGER 

THRU PROCABEC-LINK-TO-LOGGER-EXIT 

END-IF 
END-IF 

EXEC CICS RETURN END-EXEC 

A100-END-PROGRAM-EXIT. 
EXIT. 



******************************* 



*********** ******************************************** *********** 



* COMMON ROUTINE COPYBOOKS 



-INC 
-INC 
-INC 



CWXL9920 
CWXL9900 
CWPL9090 



% 
% 
% 



TRACE-IT. 



IF PARA- 
ADD : 

set : 

ELSE 

SET : 
END-IF. 



-NDX > 39 
1 

PARA- NDX 



TO 
TO 



TRACE-CYCLE 
1 



PARA- NDX UP BY 



1 



MOVE WORK- PARA 
MOVE WORK- PARA 



TO 
TO 



PARA- ID ( PARA- NDX ) 
PARA-ID (1) 



TRACE-IT-EXIT. 
EXIT. 



□ 



APPENDIX G 



****************************************************************** 

IDENTIFICATION DIVISION. 
***************************** 

PROGRAM-ID. CWUBB100 . 

AUTHOR. CUBIC/CTS. 
INSTALLATION. 

DATE-WRITTEN. JANUARY 2000. 
DATE-COMPILED. 

****************************************************************** 

* * 

* PROGRAM NAME: CREATE INDICES FILE FOR BENEFITS TABLE * 

* PROGRAM-ID: CWUBB100. * 

* * 

* SYSTEM: 9121-490, MVS/ESA, CICS, COBOL II, ORACLE * 

* PROJECT: 170-2719, ELECTRONIC BENEFITS DISTRIBUTION SYSTEM * 

* DESC: INDICES FILE USED FOR THE BENEFITS VIEW SCREEN * 

* * 

* INPUTS: * 

* BENEFITS ORACLE TABLE * 

* * 

* OUTPUTS: * 

* DEFMFB1 BENEFTIS INDICES * 

* * 

* ERRORS: * 

* * 

* REVISION HISTORY: * 

* * 
****************************************************************** 

* 01/25/00 SMB000 RONO INITIAL PROGRAM 

****************************************************************** 
/***************************************************************** 

ENVIRONMENT DIVISION. 
****************************************************************** 

CONFIGURATION SECTION. 

SPECIAL-NAMES. C01 IS TOP-OF-PAGE. 

SOURCE-COMPUTER. ES-9000. 

OBJECT-COMPUTER. ES-9000. 

INPUT-OUTPUT SECTION. 
FILE-CONTROL. 

SELECT BENEFITS-INDICES-FILE ASSIGN TO DEFMFB1 

ORGANIZATION INDEXED 

ACCESS DYNAMIC 

RECORD KEY MFB1-KEY 

FILE STATUS MFB1-STATUS. 

/***************************************************************** 
DATA DIVISION. 

****************************************************************** 



FILE SECTION. 



FD BENEFITS- INDICES -FILE . 
01 MFB1-RECORD . 

05 MFB1-KEY 

05 FILLER 



PIC 
PIC 



X(30) 
X(10) 



/ 



WORKING- STORAGE SECTION . 

01 MFB1 -STATUS -FLAGS . 

05 MFB1-STATUS PIC 9(02). 

88 MFB1-SUCCESSFUL-IO VALUE 00. 

88 MFB1- DUPLICATE VALUE 22. 

88 MFB1 -NOT- FOUND VALUE 23. 

88 MFB1 -NULL- FILE VALUE 35. 

88 MFB1-END-OF-FILE VALUE 10. 

05 MFB1 -OPEN- FLAG PIC 9(01) VALUE 0. 

88 MFB1- FILE -NOT-OPEN VALUE 0. 

88 MFB1-FILE-OPEN-I-0 VALUE 1. 

88 MFBl-FILE-OPEN-OUTPUT VALUE 2. 

0 1 BATCH-RETURN-CODE . 
COPY CWWL94 50. 



0 1 BATCH-RETURN-CODE . 
COPY CWWL9450. 



01 MISC-FIELDS. 
05 WS-DT-TM. 

10 WS-DT-BYTE 
05 WS-BIN-2N 
05 WS-BIN-2X REDEFINES 

10 WS-B2-HI 

10 WS-B2-LO 
05 WS-GMT 
05 WS-CCYYMMDD-HHMISS . 

10 WS-DT-CC 

10 WS-DT-YY 

10 WS-DT-MM 

10 WS-DT-DD 

10 WS-DT-HH 

10 WS-DT-MI 

10 WS-DT-SS 



OCCURS 7 TIMES PIC X. 

PIC S9(4) COMP. 
WS-BIN-2N. 

PIC X. 

PIC X. 

PIC S9(8) COMP. 



PIC 
PIC 
PIC 
PIC 
PIC 
PIC 
PIC 



99. 
99. 
99. 
99. 
99. 
99. 
99. 



05 WS-DT-TM-N REDEFINES WS-CCYYMMDD-HHMISS 
05 WS-SERIAL-NUM. 



10 
10 



WS-SN-HI-2 
WS-SN-LO-4 



PIC S9(4) 
PIC S9(8) 



PIC 9(14) 

COMP. 
COMP. 



01 ACCEPT- PARMS. 

05 AP-SERIAL-NUM. 
10 AP-SN-HI-5 
10 AP-SN-LO-10 



PIC 
PIC 



9(5) . 
9(10) 



01 DISPLAY-VARIABLES. 

05 D-MFG-SERIAL-NUM 

05 D-EMP-NAME PIC X(10) 



PIC X{10) 



05 D-SALARY PIC Z(4)9.99. 

05 D-COMMISSION PIC Z(4)9.99. 

05 D- INITIAL- VAL-AMT PIC Z(2)9.99. 

05 D-SQLCODE PIC -9(5). 

EXEC SQL BEGIN DECLARE SECTION END-EXEC. 

+ BENEFITS COLUMN DEFINITIONS 

-INC CWELB100 

EXEC SQL END DECLARE SECTION END-EXEC. 

EXEC SQL INCLUDE SQLCA END-EXEC 

EXEC SQL DECLARE ALL_BENEFITS CURSOR FOR 
SELECT 

-INC CWELB800 

FROM MCHECK. BENEFITS 
END-EXEC 

/ 

PROCEDURE DIVISION. 

A000-CONTROL. 

DISPLAY 'A000: 

EXEC SQL WHENEVER SQLERROR 

DO PERFORM Z30 0-SQL- ERROR END-EXEC 
DISPLAY ' STEP 1' 

EXEC SQL OPEN ALL_BENEFITS END-EXEC 

MOVE SQLCODE TO D-SQLCODE 

DISPLAY 'OPEN SQLCODE: ' D-SQLCODE 

PERFORM B100-INITIALIZE THRU 
B100-INITIALIZE-EXIT 

PERFORM C100-CREATE-INDICES THRU 
C100-CREATE-INDICES-EXIT 
UNTIL SQLCODE = +100 
OR SQLCODE = +1403 

PERFORM Z100-SIGN-OFF THRU 
Z100-SIGN-OFF-EXIT 

A000-CONTROL-EXIT . 
EXIT. 
GOBACK. 

B100-INITIALIZE. 

DISPLAY 'B100: 

B100-INITIALIZE-EXIT. 
EXIT. 

C100-CREATE-INDICES . 
DISPLAY f C100: 



FETCH BENEFITS ROW 



* WRITE INDEX FILE 



EXEC SQL FETCH ALL_BENEFITS 
INTO 

-INC CWELB805 % 
END-EXEC 

BEN-SERIAL-NUM 
BEN- CUSTOMER- ID 
BEN- BENE FIT -TYPE 
BEN-EFFECTIVE-DATE 

C100-CREATE-INDICES-EXIT . 
EXIT. 

*** THIS OPENS THE INDECES FILE 
***************++************+**^ 

V015-OPEN-MFB1. 

DISPLAY 'V015: ' . 

OPEN 1-0 BENEFITS -INDICES -FILE 

EVALUATE TRUE 

WHEN MFB1-SUCCESSFUL-IO 

SET MFB1-FILE-OPEN-I-0 TO TRUE 

WHEN MFB1 -NULL- FILE 

OPEN OUTPUT BENEFITS -INDICES- FILE 

EVALUATE TRUE 

WHEN MFB1-SUCCESSFUL-IO 

SET MFB1-FILE-OPEN-OUTPUT TO TRUE 
WHEN OTHER 

DISPLAY 'ERROR OPENING **OUTPUT** BENEFITS INDICES' 
' BEN IND FILE - ' 
'STATUS: * MFB1-STATUS 
SET BRC- OPEN-ERROR TO TRUE 
END- EVALUATE 
WHEN OTHER 

DISPLAY 'ERROR OPENING ** 1-0 ** BEN INDICES ' 
'FILE - ' 
'STATUS: 1 MFB1-STATUS 
SET BRC-OPEN- ERROR TO TRUE 
END- EVALUATE 

V015-OPEN-MFB1-EXIT . 
EXIT. 

**+************++************+****^ 

*** CREATES DUMMY RECORD FOR BENEFITS INDECES FILE 
*****+++*+**+**+***+*****+*************^ 

VO 18 -CREATE- DUMMY-M FBI . 



DISPLAY 

' -k i 

' _ * _ » 



DISPLAY ' V018 : ' 



OPEN OUTPUT BENEFITS -INDICES- FILE 

EVALUATE TRUE 

WHEN MFB1-SUCCESSFUL-IO 

CONTINUE 
WHEN OTHER 

DISPLAY ' DUMMY RECORD PROCESSING. 

DISPLAY 'ERROR OPENING BENEFITS INDICES FILE - ' 

' STATUS : 1 MFB1-STATUS 
SET BRC-OPEN-ERROR TO TRUE 
GO TO VO 18 -CREATE- DUMMY-MFB1- EXIT 
END- EVALUATE 

MOVE LOW-VALUES TO MFB1-RECORD 

WS-MFB1-KEY 

MOVE 'DUMMY' TO WS-MFBl-SET- I D 

MOVE WS-MFB1-KEY TO MFB1-KEY 

WRITE MFB1-RECORD 
EVALUATE TRUE 

WHEN MFB1-SUCCESSFUL-IO 

CONTINUE 
WHEN OTHER 

DISPLAY 1 DUMMY RECORD PROCESSING. 

DISPLAY f V018: ERROR WRITING BENEFITS INDICES FILE - ' 
'STATUS: ' MFBl-STATUS 
' BEN INDICES: KEY: ' 
MFB1-KEY 
SET BRC-OPEN-ERROR TO TRUE 
GO TO VO 18 -CREATE- DUMMY-MFB1 -EXIT 
END-EVALUATE 

CLOSE BENEFITS -INDICES -FILE 

VO 18 -CREATE- DUMMY-MFB 1 - EXI T . 
EXIT. 

*** THIS READS BENEFITS INDICES FILE TO DETERMINE UPDATE/WRITE 
VO 30 -UP DATE- BEN- INDICES . 



EVALUATE TRUE 

WHEN MFB1-FILE-OPEN-I-0 

READ BENEFITS-INDICES-FILE 
EVALUATE TRUE 
WHEN MFB1-SUCCESSFUL-IO 
PERFORM VO 3 3-REWRITE-BEN- INDICES THRU 
V033-REWRITE-BEN- INDICES-EXIT 
WHEN MFB1 -NOT- FOUND 
PERFORM VO 3 5 -WRITE- BEN- IN DICES THRU 
VO 3 5 -WRITE- BEN- IN DICES -EX IT 
WHEN OTHER 

DISPLAY 'ERROR READING BENEFITS INDICES FILE - 
'STATUS: ' MFBl-STATUS 
' 1-30: ' BEN-INDICES (1 : 20) 

SET BRC-IO-ERROR TO TRUE 



END- EVALUATE 
WHEN MFB1-FILE-0PEN-0UTPUT 

PERFORM VO 3 5 -WRITE-BEN- INDICES THRU 
VO 3 5 -WRITE-BEN- INDICES-EXIT 

WHEN OTHER 

DISPLAY ' ERROR READING FARE BEN INDICES FILE - ' 
' STATUS : ' MFB1-STATUS 
' 1-20: ' BEN-INDICES (1 : 20) 

SET BRC-IO-ERROR TO TRUE 
END-EVALUATE 

VO 30 -UPDATE- BEN- INDICES -EXIT . 
EXIT. 

/****************************^ 

*** REWRITES BENEFITS INDICES RECORD 



VO 3 3 -REWRITE- BEN- INDICES . 



REWRITE M FBI-RECORD FROM BEN-INDICES 

EVALUATE TRUE 

WHEN MFB1-SUCCESSFUL-IO 

ADD 1 TO WS-MFB1-WRITE 

WHEN OTHER 

DISPLAY ' ERROR RE-WRITING BENEFITS INDICES FILE - ' 
'STATUS: ' MFBl-STATUS 
' BEN IND TABLE: KEY: ' 
MFB1-KEY 
SET BRC-IO-ERROR TO TRUE 
END- EVALUATE 

VO 3 3- REWRITE-BEN- INDICES -EX IT . 
EXIT. 

*** WRITES NEW BENEFITS INDICES RECORD 
VO 3 5-WRITE-BEN- INDICES . 



WRITE MFB1-RECORD FROM BEN-INDICES 

EVALUATE TRUE 

WHEN MFB1-SUCCESSFUL-IO 

ADD 1 TO WS-MFB1-WRITE 

WHEN OTHER 

DISPLAY 'ERROR WRITING BENEFITS INDICES FILE - ' 
'STATUS: ' MFBl-STATUS 
' BEN INDICES: KEY: ' 
MFB1-KEY 
SET BRC-IO-ERROR TO TRUE 
END-EVALUATE 



VO 3 5-WRITE-BEN- IND ICES -EX IT . 
EXIT. 

*** THIS CLOSES THE BENEFITS INDICES FILE 



V070-CLOSE-MFB1 . 



DISPLAY 'V070: ' . 

CLOSE BENEFITS- INDICES- FILE 

EVALUATE TRUE 

WHEN MFB1-SUCCESSFUL-I0 
CONTINUE 

WHEN OTHER 

DISPLAY 'ERROR CLOSING BENEFITS INDICES FI 

'STATUS: ' MFB1-STATUS 
SET BRC-CLOSE- ERROR TO TRUE 
END-EVALUATE. 

V070-CLOSE-MFB1-EXIT . 
EXIT. 

Z100-SIGN-OFF. 

EXEC SQL CLOSE ALL_BENEFITS END-EXEC 
DISPLAY ' ' 

DISPLAY 1 HAVE A GOOD DAY!' 
DISPLAY ' ' 

EXEC SQL COMMIT WORK RELEASE END-EXEC 
GOBACK 

Z100-SIGN-OFF-EXIT. 
EXIT. 

Z300-SQL- ERROR . 

MOVE SQLCODE TO D-SQLCODE 

EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC 
DISPLAY ' ' 

DISPLAY 'ORACLE ERROR DETECTED: 1 D-SQLCODE 
DISPLAY ' * 
DISPLAY SQLERRMC 

EXEC SQL ROLLBACK WORK RELEASE END-EXEC 
GOBACK 

Z300-SQL-ERROR-EXIT . 
EXIT. 



APPENDIX H 



IDENTIFICATION DIVISION. 

PROGRAM- I D . CWOCB 100. 

AUTHOR . CUBIC/CTS. 
INSTALLATION. 

DATE-WRITTEN. JANUARY 2000. 
DATE-COMPILED. 

******************+******++********^ 

PROGRAM NAME: BENEFITS VIEW/MAINTENANCE 
PROGRAM ID: CWOCB100 



SYSTEM: 9121-490, MVS/XA, CICS, COBOL II, ORACLE 
PROJECT: 170-2719, ELECTRONIC BENEFITS DISTRIBUTION SYSTEM 



DESC: 

INPUTS: 

OUTPUTS : 
ERRORS : 



THIS PROGRAM ALLOWS THE USER TO VIEW 

BENEFITS INFORMATION. BENEFITS CAN BE VIEWED BY 

MANUFACTURER SERIAL NUMBER OR CUSTOMER ID. 



- STANDARD COMMAREA 

- USER COMMAREA ATTACHED TO STANDARD COMMAREA 
( CWLLB1 0 0 COPYBOOK) 

- BENEFITS TABLE (ORACLE) 

- NONE 

- SEE WS-ERROR-MESSAGES FOR A LIST OF ERRORS PUT OUT 
BY THIS PROGRAM 



REVISION HISTORY: 

MM/DD/YY XX9999 XXXX DESCRIPTION 



DATA DIVISION. 



WORKING-STORAGE SECTION. 



WS- 


ID- ARE AS. 








05 


FILLER 


PIC 


X(16) 


VALUE 




1 START OF WS FOR 1 . 








05 


WS-PROGRAM-ID 


PIC 


X(08) 


VALUE 


05 


FILLER 


PIC 


X(12) 


VALUE 




' COMPILE ON f . 








05 


WS-WHEN-COMPILED 


PIC 


X(16) 


VALUE 


05 


FILLER 


PIC 


X(04) 


VALUE 


05 


WS-BMS-MAP-SET 


PIC 


X(08) 


VALUE 


05 


WS-BMS-MAP 


PIC 


X{08) 


VALUE 


05 


WS-NEXT - PGM- DOWN 


PIC 


X(08) 


VALUE 



*00000100 
00000200 
*00000300 
00000400 
00000500 
00000600 
00000700 
00000800 
*00000900 
*00001000 
*00001100 
*00001200 
*00001300 
*00001400 
*00001500 
*00001600 
*00001700 
*00001800 
*00001900 
*00002000 
*00002100 
*00002300 
*00002400 
*00002500 
*00002600 
*00002700 
*00002800 
*00003100 
*00003200 
*00003300 
*00003400 
*00003500 
*00003600 
*00003700 
*00003800 
*00003700 
*00004000 
*00003900 
*00003900 
*00003900 
*00005400 
00005500 
00005600 
00005700 
00005800 
00005900 
00006000 
00006100 
00006200 
.00006300 
00006400 
00006500 
00006600 
00006700 
.00006800 
.00006900 
.00007000 



01 WS-TRACE-AREA . 
05 FILLER 

' ***TRACE AREA*** 1 
05 WORK- PARA 
05 TRACE-CYCLE 
05 FILLER 
05 PARA-ID 

/ 

01 WS-PROCESS-AREA. 
COPY CWWL0080. 

01 SKLEAST-AREA. 
COPY CWWL5200. 



01 SK-MAX-QUEUE 



/ 



01 RF-REFERENCE-RCD. 
COPY CWVL0300. 

01 RF-TABLE- ID- VALUES . 
COPY CWWL0388. 



01 WS-WORK-AREAS. 

05 WS-DISP-NUM-5 
WS-DISP-NUM-10 
WS-DISP-DEC-FMT-5 
WS-DISP-ZZ9 
WS-BIN-3X. 
10 WS-BIN-3X-HI 
10 WS-BIN-3X-LO 
WS-BIN-3C 

REDEFINES WS-BIN-3X 



05 
05 
05 
05 



05 



PIC X(16) VALUE 



PIC 
PIC 
PIC 
PIC 



X(08) 
9(05) 
X(02) 
X(08) 



VALUE ZEROES. 
VALUE ' * * 1 . 



PIC 9(02) VALUE 1. 



PIC Z(4)9. 
PIC Z(9)9. 
PIC Z(02)9. 
PIC ZZ9 . 



99. 



PIC 
PIC 



X(01) 
X (03) 



VALUE LOW-VALUES 



PIC S9(08) COMP. 



05 WS-BIN-2X. 

10 WS-BIN-2X-HI 
10 WS-BIN-2X-LO 

05 WS-BIN-2C 

REDEFINES WS-BIN-2X 

05 WS-USERID 

01 WS - PART I CULAR-AREAS . 
05 WS-GET-ROW-FLAG 

88 WS-GET-NEXT-ROW 

88 WS-GET-PREVIOUS-ROW 

88 WS-GET-CURRENT-ROW 



PIC X(01) VALUE LOW-VALUES 
PIC X(01). 

PIC S9(04) COMP. 

PIC X(08) VALUE SPACES. 



PIC 9. 

VALUE 1. 
VALUE 3. 
VALUE 5. 



05 WS-SAVE-MFB1-KEY 

05 WS- SEARCH -FLAG 

88 WS-GOOD-SEARCH 
88 WS-END-SEARCH 

05 WS-FUNCTION-ID 
88 WS-STARTBR 



PIC X(68). 

PIC 9 VALUE 0. 

VALUE 0. 
VALUE 1. 

PIC X (8) . 
VALUE ' START BR ' . 



00007100 
00007200 
00007300 
00007400 
00007500 
00007600 
00007700 
00007800 
00008100 
00008200 
00008300 
00008100 
00008200 
00008300 
00008400 
00008500 
00008600 
00008700 
00008800 
00008900 
00009000 
00009100 
00009500 
00009600 
00013400 
00013400 
00013400 
00013400 
00010400 
00010500 
00010600 
00010700 
00010800 

00010900 
00011000 
00011100 
00011200 
00011300 
00013700 
00013700 
00013700 
00013800 
00014200 
00014400 
00014500 
00014600 

00013700 
00014200 
00013700 
00014200 



00013700 
00014200 



88 WS-READNEXT VALUE ' READNEXT 1 

88 WS-READPREV VALUE ' READPREV 1 



05 



ws- 


DESC 




PIC 


X(15) . 






ws- 


•FORMAT -DATE. 












10 


WS- FORMAT- DATE- 


■YYYY 


PIC 


9(04). 






10 


FILLER 




PIC 


X(01) 


VALUE 


'/ 


10 


WS - FORMAT- DATE- 


•MM 


PIC 


9 (02) . 






10 


FILLER 




PIC 


X(01) 


VALUE 


'/ 


10 


WS- FORMAT- DATE- 


•DD 


PIC 


9(02) . 






ws- 


FORMAT-TIME. 












10 


WS- FORMAT-TIME- 


•HH 


PIC 


9 (02) . 






10 


FILLER 




PIC 


X(01) 


VALUE 


i . 


10 


WS- FORMAT-TIME- 


■MM 


PIC 


9 (02) . 






10 


FILLER 




PIC 


X(01) 


VALUE 




10 


WS- FORMAT- T I ME- 


■SS 


PIC 


9(02) . 







WS-PFKEY-MES SAGES . 
05 WS-PFKEY-MSG1. 

10 FILLER PIC X(40) 

1 PF4=UPDATE 9=CARDBACK 10=CARDFWD 



10 FILLER 

05 WS-PFKEY-MSG2 . 
10 FILLER 

'PF2-SET HOLD 6=BROWSE 
10 FILLER 

05 WS-PFKEY-MSG3. 
10 FILLER 

' PF5=CONFIRM 6=BROWSE 
10 FILLER 



PIC X(20) 

PIC X(33) 

PIC X(20) 

PIC X(33) 

PIC X(20) 



VALUE 
VALUE 

VALUE 
VALUE 

VALUE 
VALUE 



BIT-MASK- VALUES. 
COPY CWWL9410. 



WS-ERROR-MESSAGES . 
05 WS-B101-NUM 
05 WS-B101-MSG 

1 ENTER CARD SER# 



PIC 
PIC 



X(04) 
X (63) 



VALUE 
VALUE 



'B101' 



05 WS-B102-NUM 
05 WS-B102-MSG 



PIC 
PIC 



X(04) 
X(63) 



VALUE 
VALUE 



'NOW YOU CAN TOGGLE THE HOLD ON THIS ROW 



'B102 ' 



05 WS-B103-NUM PIC X(04) VALUE 

05 WS-B103-MSG PIC X(63) VALUE 

' YOU ARE NOW IN THE BROWSE MODE 



'B103' 



05 WS-B105-NUM PIC X(04) VALUE 

05 WS-B105-MSG PIC X{63) VALUE 

'PRESS PF5 TO COMMIT CHANGE 



'BIOS' 



00017800 

00019100 
00019200 
00019300 
00019400 
00019500 
00019600 
00019700 
00019800 
00019900 
00020000 
00020100 
00020200 

00021000 
00021100 
00021200 
00021300 
00021400 
00021500 
00021600 
00021700 
00021800 
00021900 
00022000 
00021600 
00021700 
00021800 
00021900 
00022000 
00022100 
00022200 
00022400 
00022500 
00022600 
00022700 
00022800 
00022900 
00023000 
00023100 
00022200 
00022900 
00023000 
00023100 
00022200 
00022900 
00023000 
00023100 
00022200 
00022900 
00023000 
00023100 



05 WS-B115-NUM 


PIC 


X(04) 


VALUE 


'B115 


05 WS-B11 5-MSG . 










10 WS-B115-SERIAL-NUM 


PIC 


X(15) . 






1 n FTT.T.FR 


DTP 


V 
A 




i * i 


10 WS-B1 15 -CUSTOMER- I D 


PIC 


X(14) . 






10 FILLER 


PIC 


X 


VALUE 


i * t 


10 WS-B115-BENEFIT-TYPE 


PIC 


X(5) . 






1 n FT T T.FR 




Y 
A 


VnLUij 


i * t 


10 WS-B115-EFFECTIVE-DATE 


PIC 


X(14) . 






10 FILLER 


PIC 


X 


VALUE 


i + i 


05 WS-B12 1-NUM 


PIC 


X(04) 


VALUE 


T B121 


05 WS-B12 1-MSG 


PIC 


X (63) 


VALUE 




1 ENTRY MUST BE NUMERIC: 










05 WS-B18 0-NUM 


PIC 


X (04) 


VALUE 


'B180 


05 WS-B18 0-MSG . 










10 FILLER 


PIC 


X (50) 


VALUE 




'12345 ROW - END OF LIST 










10 FILLER 


PIC 


X(13) 


VALUE 





05 WS-B18 1-NUM PIC X(04) VALUE 
05 WS-B18 1-MSG . 

10 FILLER PIC X(50) VALUE 

'SQL CODE: XXXXX PARA: 123 4 567 8 

10 FILLER PIC X(13) VALUE 
NEW PROG 1 . 



'B181' 



05 WS-B183-NUM PIC X(04) VALUE 

05 WS-B183-MSG. 

10 FILLER PIC X(36) VALUE 

1 UNSUCCESSFUL BEFORE IMAGE WRITE TO 
10 FILLER PIC X(27) VALUE 

' SYSTLOG 



'B183' 



05 WS-B184 -NUM PIC X(04) VALUE 'B184' 
05 WS-B184 -MSG . 

10 FILLER PIC X(36) VALUE 

' UNSUCCESSFUL AFTER IMAGE WRITE TO 

10 FILLER PIC X(27) VALUE 
1 SYSTLOG 

05 WS-B18 5-NUM PIC X(04) VALUE 'B185 f 
05 WS-B18 5-MSG . 

10 FILLER PIC X(36) VALUE 

'ERROR DATE/TIME CONVERT. PLEASE EXIT 1 . 

10 FILLER PIC X(27) VALUE 



05 WS-B18 6-NUM 
05 WS-B18 6-MSG . 
10 FILLER 

'DATE PGM LINK ERROR, RESP= . 
10 FILLER PIC X{27) VALUE 

' PLEASE EXIT. 



PIC X(04) VALUE 'B186 1 
PIC X(36) VALUE 



00022200 
00022900 
00023000 
00023000 
00023000 
00023000 
00023000 
00023000 
00023000 
00023000 
00023000 
00022200 
00023500 
00023600 
00023700 
00022200 
00022900 
00023000 
00023000 
00023100 
00023000 
00023100 
00022200 
00022900 
00023000 
00023000 
00023100 
00023000 
00023100 
00022200 
00025600 
00025700 
00025800 
00025900 
00025800 
00025900 
00022200 
00025600 
00025700 
00025800 
00025900 
00025800 
00025900 

00025600 
00025700 
00025800 

00025800 
00025900 

00025600 
00025700 
00025800 

00025800 
00025900 



05 WS-B187-NUM 
05 WS-B187-MSG. 
10 FILLER 

' INVALID MANUAL HOLD COD 
10 FILLER 

'T CHANGED! 

05 WS-B188 -NUM 
05 WS-B188 -MSG . 

10 FILLER 

' UNABLE TO TOGGLE VENDOR 

10 FILLER 



05 WS-B189-NUM 
05 WS-B1 8 9-MSG . 

10 FILLER 

'VSAM ERROR RESP: XXXXX 

10 FILLER 



PIC X(04) VALUE 'B187' . 

PIC X(36) VALUE 
: CODE NO' . 

PIC X(27) VALUE 



PIC X(04) VALUE 'B187'. 

PIC X(36) VALUE 
HOLD CODE 
PIC X(27) VALUE 



PIC X(04) VALUE 'B189' . 

PIC X{50) VALUE 

.: 12345678 

PIC X(13) VALUE 



05 WS-B1 90-NUM 
05 WS-B1 90-MSG . 

10 FILLER 

' INVALID SEARCH FLAG: X 

10 FILLER 



PIC X(04) VALUE ' B190' 
PIC X(50) VALUE 

i 

PIC X(13) VALUE 



05 WS-B1 91-NUM 
05 WS-B1 91-MSG . 

10 FILLER 

INVALID SEARCH FLAG: X 

10 FILLER 



PIC X(04) VALUE 'B191' 
PIC X(50) VALUE 
PIC X(13) VALUE 



*** RESP CODE 

05 WS- RESP- 9- DISPLAY 

/ 

01 COMMON- DEFINITIONS . 
COPY CWWL0020. 

/ 

0 1 SCREEN-QUEUE- AREA . 
COPY CWQL5500. 

/ 

01 WS-GENERAL-DATA. 
05 WS-FCI 

88 WS-FCI-TERM 
05 WS-MAP-LEN 

05 WS-MAP-PTR 

05 WS- RECORD- LENGTH 

05 WS-ITEM 

05 I 



PIC 9 (02) . 



PIC X{01) . 

VALUE X' 01 ' . 
PIC S9(04) COMP 

VALUE ZEROES. 
USAGE IS POINTER. 
PIC S9(04) COMP. 
PIC S9(04) COMP 

VALUE +1. 
PIC S9{04) COMP. 



00025600 
00025700 
00025800 

00025800 
00025900 

00025600 
00025700 
00025800 

00025800 
00025900 
00022200 
00022900 
00023000 
00023000 
00023100 
00023000 
00023100 
00022200 
00022900 
00023000 
00023000 
00023100 
00023000 
00023100 
00022200 
00022900 
00023000 
00023000 
00023100 
00023000 
00023100 
00022200 



00026400 
00026500 
00026600 
00026700 
00026800 
00026900 
00027000 
00027100 
00027200 
00027300 
00027400 
00027500 
00027600 
00027700 
00027800 
00027900 
00027800 



01 NUMERIC-CHECK- VARIABLES . 
COPY CWWL9020. 

/ 

01 UNSTRING- VARIABLES . 
COPY CWWL9030. 

/ 

01 STANDARD-COP I ED-MESSAGES . 
COPY CWWL0030. 

/ 

01 S K- C I C S - RE FORMAT -AREA . 
COPY CWWL9090. 

/ 

01 MESSAGE-ROUTER-LINKAGE . 
COPY CWLL3300. 

/ 

01 SYSTEM-LOGGER-COMMAREA. 
COPY CWLL3100. 

/ 

01 DATE-TIME-CONVERSION. 
COPY CWLL3000. 

/ 

COPY DFHBMSCA. 
COPY DFHAID. 

/ 

01 ORACLE-SQL-CODES . 
-INC CWELBOOO 



00028200 
00028300 
00028400 
00028500 
00028600 
00028700 
00028800 
00028900 
00029000 
00029100 
00029200 
00029300 
00029400 
00029500 
00029600 
00029700 
00029800 
00029900 
00030000 
00030100 
00030200 
00030300 
00030400 
00030500 
00030600 
00030700 

00013400 



* SQL HOST VARIABLES 

/ 

EXEC SQL 

BEGIN DECLARE SECTION 
END-EXEC 

-INC CWELB100 
+ 

-INC CWELB101 

01 BENEFITS-DEFINITION-ROW. 
05 BND-BENEFIT-DESC 



PIC X(60) VARYING. 



00030800 
00030900 
00031000 
00031100 
00031200 
00031000 
% 

00031000 



00013400 
00013500 



01 WS-SQL-HOST-VARIABLES . 

05 WS-PROCESS-DATE PIC X(7). 

05 WS-PROCESS-DATE -XI 4 PIC X(14) 

05 WS-PD-X14 REDEFINES WS-PROCESS-DATE-X14 . 
10 WS-PD-DATE. 



15 


WS 


-PD- 


-cc 


15 


WS 


-PD- 


-YY 


15 


WS 


-PD- 


-MM 


15 


WS 


-PD- 


-DD 



10 WS-PD-TIME. 
15 WS-PD-HH 
15 WS-PD-MI 
15 WS-PD-SS 
05 WS-USER-ID 



PIC 
PIC 
PIC 
PIC 

PIC 
PIC 
PIC 
PIC 



S99. 
S99. 
S99. 
S99. 

S99. 
S99. 
S99. 
X(8) . 



00013400 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00013500 
00014000 



00013300 

EXEC SQL VAR 

WS-PROCESS-DATE IS DATE 

END-EXEC 

00013300 

EXEC SQL 

END DECLARE SECTION 
END-EXEC 



EXEC SQL 

INCLUDE SQLCACOB 
END-EXEC 



EXEC SQL 

INCLUDE SQLCA 
END-EXEC 



EXEC SQL 

INCLUDE ORACA 
END-EXEC 



01 WS-MISC-FIELDS. 

05 WS-SQLCODE-DISP PIC -(4)9. 

05 WS-SQLCODE-C PIC X(9) . 

05 WS-SQLCODE REDEFINES WS-SQLCODE-C PIC 9(9). 
05 HV-SERIAL-NUM PICX{15). 

88 HV-FIRST-SER-NUM VALUE '000000000000001 
05 HV-MFG-SERIAL-NUM PICX(ll). 

88 HV-FIRST-MFG-SER-NUM VALUE ' 00000000001 ' . 
05 HV-CUSTOMER-ID PICX(14). 

88 HV-FIRST-CUST-ID VALUE 1 AAAAAAAAAAAAAA ' , 



01 WS-MFB1-RECORD. 
COPY CWVLB100. 



01 WS-QUEUE-DATA. 

05 WS-SCREEN-LOGIC-DATA. 
10 WS -ORDER- FLAG 

88 WS- SERIAL-ORDER 
88 WS -NAME-ORDER 
88 WS-MFG-ORDER 

/ 

LINKAGE SECTION . 

01 DFHCOMMAREA . 

COPY CWLL0000. 

/ 

COPY CWLLB100. 

/ 

*** SCREEN CWOB100 COPYBOOK. 
COPY CWOB100. 

/ 
/ 

01 GETMAI N-AREA 



PIC 9(01). 

VALUE 1. 
VALUE 2. 
VALUE 3. 

00050500 
00052500 
00052600 
00052700 
00052800 
00052900 
00053000 
00053100 
00053200 
00053200 
00053200 
00053200 
00053300 
00053400 
00053600 

PIC X{8000). 00053700 



01 BIG-AREA PIC X(4000). 

/ 

PROCEDURE DIVISION. 
A000-CONTROL-PROCESS . 

MOVE WHEN-COMPILED TO WS-WHEN-COMPILED . 

EXEC CICS ASSIGN 

FCI (WS-FCI) 

END-EXEC. 

IF NOT WS-FCI-TERM 

GO TO SKABEX IT-NO- TERM 
END-IF . 

IF EIBCALEN = ZEROES 

GO TO SKABEXIT-NO-COMMAREA 
END-IF 



SET ADDRESS OF CWOB100O TO STC-MAP-PTR 

SET WS-MAP-PTR TO STC-MAP-PTR 

SET SQA-EXTRA-QUE TO TRUE 



MOVE SPACES TO MSGIO 

MSG20 
MSG30 



EVALUATE TRUE 

WHEN STC-NEXT- SCREEN 

PERFORM B000-INITIAL-SEND 

THRU B000-INITIAL-SEND-EXIT 



WHEN STC- GOING-LATERAL 

PERFORM F000-LATERAL-PROCESS 

THRU F000-LATERAL-PROCESS-EXIT 



WHEN OTHER 

GO TO SKABEXIT-LEVEL2 
END-EVALUATE 



SMB000 EXEC SQL 

COMMIT WORK RELEASE 
END-EXEC 



MOVE 


WS- PROGRAM- ID 


TO 


PROGNAMO 


MOVE 


MSGNUMO 


TO 


STC-HELP-MSG 


MOVE 


WS-BMS-MAP-SET 


TO 


STC-CURR-MAPSET 


MOVE 


WS-BMS-MAP 


TO 


STC-CURR-MAP 


MOVE 


LENGTH OF CWOB100O 


TO 


STC-MAP-LEN 



EXEC CICS XCTL 

PROGRAM ( C D- NAMED- PGM ) 
COMMAREA ( DFHCOMMAREA) 
LENGTH (EIBCALEN) 
RESP (WS-RESP) 



00053800 
00053900 
00054000 
00054100 
00054200 
00054300 
00054900 
00055000 
00055100 
00055200 
00055300 
00055400 
00055500 
00055600 
00055700 
00055800 
00055900 
00056000 
00056100 
00056200 
00031500 
00031600 
00031700 
00056500 
00058500 
00059600 
00059600 
00059700 
00056700 
00056800 
00056900 
00057000 
00057100 
00057700 
00057800 
00057900 
00058000 
00058100 
00058200 
00058300 
00058400 
00060300 
00013400 
00013400 
00013400 
00060300 
00059800 
00059900 
00060000 
00060100 
00060200 
00060600 
00060700 
00060800 
00060900 
00061000 
00061100 



/ 



END-EXEC 

IF WS-RESP NOT = DFHRESP (NORMAL) 

GO TO SKABEXIT-LEVEL2 
END-IF 

EXEC CICS RETURN 
END-EXEC. 

BOOO-INITIAL-SEND. 
***************************************************************** 

* THIS PARAGRAPH WILL PERFORM ANY INITIALIZATION NEEDED WHEN * 

* THIS PROGRAM IS INVOKED FOR THE FIRST TIME. * 
***************************************************************** 

MOVE ' B000' TO WORK- PARA. 

COMPUTE STC-MAX-QUEUE = STC-MAX-QUEUE + SK-MAX-QUEUE 



EXEC SQL SELECT 

USER INTO :WS-USER-ID 
FROM DUAL 
END-EXEC 



TO STU-USER-ID 

TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 



MOVE WS-USER-ID 

MOVE WS-B101-NUM 

MOVE WS-B101-MSG 

SET STU-INITIAL-SCREEN TO TRUE 

MOVE -1 TO CARD-SER1L 

SET CD-SCR-ROUTER-EXIT 
STC-EDIT-INITIAL 
STC-GOING- LATERAL 
STC-FCN-NA TO TRUE 

BOOO-INITIAL-SEND-EXIT. 
EXIT. 

/ 

F000-LATERAL-PROCESS . 
********************************** 

* THIS PARAGRAPH IS PERFORMED TO PROCESS USER INPUT. 
***************************************************************** 

MOVE ' F000' TO WORK- PARA 
MOVE ZEROES 
MOVE SPACES 
SET WS-EDIT-OK 



TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 

TO TRUE 



00061200 
00061300 
00061400 
00061500 
00061600 
00061700 
00061800 
00061900 
00062000 
00062100 
00062200 
00062300 
00062400 
00062500 
00062600 
00062700 
00062900 
00063000 
00062900 
00062900 



00062900 

00063100 
00063200 
00063300 
00063400 
00065100 
00065100 
00065100 
00065200 
00065100 
00066400 
00066600 
00066600 



00066900 
00067000 
00067100 
00078600 
*00078700 
*00078800 
*00078900 
00079000 
00079100 
00079300 
00079400 
00063300 
00079500 
00080000 
00079600 



EVALUATE TRUE 



00079100 



WHEN STU-INITIAL-SCREEN 

SET STU-SEARCH-SER-NUM TO TRUE 
SET STU-PREV-KEY-ENTER TO TRUE 
MOVE WS - P FKEY-MSG 1 
PERFORM M201-EDIT-SER-NUM THRU 
M201-EDIT-SER-NUM-EXIT 
IF WS-EDIT-OK 

MOVE HV-SERIAL-NUM 
MOVE ' 00000000000001 f 
PERFORM F100-DISP-NEXT-ROW THRU 
F100-DISP-NEXT-ROW-EXIT 
IF WS-EDIT-OK 

SET STU-BROWSE TO TRUE 

END-IF 
END-IF 



TO PFKEY-MSGO 



TO BEN-SERIAL-NUM 
TO BEN-CUSTOMER-ID 



00079100 

00079100 
00079100 
00079100 
00079100 



00079100 
00079100 



WHEN STU-BROWSE 



00079100 



MOVE STU-BEN-ROW 



TO BENEFITS-ROW 



MOVE WS-PFKEY-MSG1 TO 
PERFORM M2 00 -EDIT- SEARCH-KEY THRU 
M2 00 -EDIT- SEARCH-KEY-EXIT 
IF WS-EDIT-ERROR 

GO TO F000-LATERAL-PRE-EXIT 
END-IF 



PFKEY-MSGO 



00079100 
00079100 
00079100 



IF BEN-SERIAL-NUM 
AND BEN-MFG-SERIAL-NUM 
AND BEN-CUSTOMER- ID 
EVALUATE TRUE 
WHEN EIBAID - DFHPF4 
WHEN EIBAID = DFHPF16 
MOVE WS-PFKEY-MSG2 
MOVE WS-B102-NUM 

MOVE WS-B102-MSG 
SET STU-UPDATE 



= HV-SERIAL-NUM 

- HV-MFG-SERIAL-NUM 

= HV-CUSTOMER-ID 



TO PFKEY-MSGO 
TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 
TO TRUE 



00079100 
00079100 
00079100 
00079100 
00083400 
00083400 
00079100 

00063300 



SET STU-PREV-KEY-PF4 TO TRUE 



WHEN EIBAID - DFHPF9 

WHEN EIBAID = DFHPF21 

SET WS-GET-PREVIOUS-ROW TO TRUE 
PERFORM F090-DISP-PREV-ROW THRU 
F090-DISP- PRE V- ROW-EXIT 
SET STU-PREV-KEY-PF9 TO TRUE 



00083400 
00083400 
00014500 



WHEN EIBAID = DFHPF10 

WHEN EIBAID = DFHPF22 

SET WS-GET-NEXT-ROW TO TRUE 
PERFORM F100-DISP-NEXT-ROW THRU 
F100-DISP-NEXT-ROW-EXIT 
SET STU-PREV-KEY-PF10 TO TRUE 



00083400 
00083400 
00014400 



WHEN OTHER 

PERFORM R0 50 -SELECT-CURRENT- ROW THRU 



00083400 
00013400 



R050-SELECT-CURRENT-ROW-EXIT 
IF WS- EDIT -ERROR 

GO TO FO 00 -LATERAL- PRE- EXIT 
END-IF 

MOVE BENEFITS-ROW TO STU-BEN-ROW 

PERFORM N000-FILL-SCREEN THRU 
N0O0-FILL-SCREEN-EXIT 



00013400 



00088800 
00088800 
00088800 



END-EVALUATE 
ELSE 

SET WS-GET-CURRENT-ROW 
MOVE HV-SERIAL-NUM 
MOVE HV-MFG-SERIAL-NUM 
MOVE HV-CUSTOMER-ID 



TO 



TRUE 
TO 
TO 
TO 



PERFORM F100-DISP-NEXT-ROW THRU 
F100-DISP-NEXT-ROW-EXIT 

END-IF 



BEN-SERIAL-NUM 

BEN-MFG-SERIAL-NUM 

BEN-CUSTOMER-ID 



00079100 
00079100 
00014600 



00079100 



WHEN STU-UPDATE 
MOVE STU-BEN-ROW 
MOVE WS-PFKEY-MSG2 
EVALUATE TRUE 
WHEN EIBAID = DFHPF6 
WHEN EIBAID = DFHPF18 
MOVE WS-PFKEY-MSG1 
MOVE WS-B103-NUM 

MOVE WS-B103-MSG 

SET STU-BROWSE TO TRUE 



WHEN EIBAID = DFHPF2 
WHEN EIBAID - DFHPF14 
MOVE WS-PFKEY-MSG3 
MOVE WS-B105-NUM 

MOVE WS-B105-MSG 



TO BENEFITS-ROW 
TO PFKEY-MSGO 



TO PFKEY-MSGO 
TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 



SET STU-PREV-KEY-PF6 TO TRUE 



TO PFKEY-MSGO 
TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 



00079100 
00079100 
00079100 
00079100 
00083400 
00083400 
00079100 

00063300 



00083400 
00083400 
00079100 

00063300 



SET STU-PREV-KEY-PF2 TO TRUE 



WHEN EIBAID = DFHPF5 
WHEN EIBAID = DFHPF22 

PERFORM F500-COMMIT-PROC THRU 
F500 -COMMIT- PROC- EXIT 

SET STU-PREV-KEY-PF5 TO TRUE 



00083400 
00083400 



WHEN OTHER 

SET STU-PREV-KEY-ENTER 



TO TRUE 



00083400 



END- EVALUATE 
END-EVALUATE 

F000 -LATERAL- PRE- EXIT . 



00079100 
00079100 
00089000 
00089300 



EVALUATE TRUE 
WHEN STU-BROWSE 

PERFORM F810-SET-ATTR-BROWSE THRU 
F8 10-SET-ATTR-BROWSE-EXIT 



00079100 
00079100 



EVALUATE TRUE 
WHEN STU-SEARCH-SER-NUM 
MOVE -1 

MOVE 1 BROWSE : CARD SER# ' 



TO CARD-SER1L 

TO MSG20 (1 : 18) 



WHEN STU-SEARCH-MFG-SER-NUM 
MOVE -1 

MOVE 'BROWSE: MFG SER# ' 



TO MFG-SER1L 
TO MSG20 (1 : 



18) 



WHEN STU-SEARCH-CUST-ID 
MOVE -1 

MOVE ' BROWSE : CUST ID' 



TO CUST-IDL 
TO MSG20 (1 



WHEN OTHER 
MOVE -1 
END- EVALUATE 



TO CARD-SER1L 



WHEN STU-UPDATE 

PERFORM F8 00-SET-ATTR-UPDATE THRU 
F8 OO-SET-ATTR-UPDATE-EXIT 



MOVE -1 
END- EVALUATE 



TO CARD-SER1L 



SET STC- GOING- LATERAL 
SET CD-SCR-ROUTER-EXIT 



TO TRUE 
TO TRUE 



F000-LATERAL-PROCESS-EXIT . 
EXIT. 

F090-DISP-PREV-ROW. 

SETS SPECIFIED FIELDS AS UNPROTECTED, ALLOWING UPDATE OF 
THESE FIELDS. 



MOVE ' F090PREV 1 



TO WORK- PARA 



PERFORM R200-STARTBR- INDICES THRU 
R200-STARTBR- INDICES-EXIT 

IF WS-EDIT-ERROR 

SET STC-EDIT -ERROR TO TRUE 

GO TO F090-DISP-PREV-ROW-EXIT 

END-IF 



PERFORM R3 5 O-READPREV- INDICES THRU 
R350-READPREV- INDICES-EXIT 



PERFORM R3 5 O-READPREV- INDICES THRU 
R350-READPREV- INDICES-EXIT 

IF WS-END-SEARCH 

MOVE WS-SAVE-MFB1-KEY TO WS-MFB1-KEY 



END-IF 

EVALUATE TRUE 
WHEN STU-SEARCH-SER-NUM 
MOVE WS-MFB1-X1-SERIAL-NUM 
MOVE WS-MFB1-X1-CUSTOMER-ID 
MOVE WS-MFBl -XI -BENEFIT-TYPE 
MOVE WS-MFB1 -XI -EFFECTIVE- DATE 
PERFORM Q380-X14-TO-ORA THRU 
Q380-X14-TO-ORA-EXIT 
MOVE WS-ORA-DT-TM 
MOVE WS-MFB1-X1-MFG-SERIAL-NUM 

WHEN STU- SEARCH -MFG-SER-NUM 
MOVE WS-MFB1-X2-SERIAL-NUM 
MOVE WS-MFB1-X 2 -CUSTOMER- ID 
MOVE WS-MFB1-X2 -BENE FIT-TYPE 
MOVE WS-MFB1-X2 -EFFECTIVE- DATE 
PERFORM Q380-X14-TO-ORA THRU 
Q380-X14-TO-ORA-EXIT 
MOVE WS-ORA-DT-TM 
MOVE WS-MFB1-X2-MFG-SERIAL-NUM 

WHEN STU-SEARCH-CUST-ID 
MOVE WS-MFB1-X3-SERIAL-NUM 
MOVE WS-MFB1-X3 -CUSTOMER- ID 
MOVE WS-MFB1-X3-BENEFIT-TYPE 
MOVE WS-MFB1-X 3 -EFFECTIVE- DATE 
PERFORM Q380-X14-TO-ORA THRU 
Q380-X14-TO-ORA-EXIT 
MOVE WS-ORA-DT-TM 



TO BEN-SERIAL-NUM 

TO BEN-CUSTOMER-ID 

TO BEN-BENEFIT-TYPE 

TO WS- DATE- TIME 



TO BEN-EFFECTIVE-DATE 
TO BEN-MFG-SERIAL-NUM 



TO BEN-SERIAL-NUM 

TO BEN-CUSTOMER-ID 

TO BEN-BENEFIT-TYPE 

TO WS- DATE- TIME 



TO BEN-EFFECTIVE-DATE 
TO BEN-MFG-SERIAL-NUM 



TO BEN-SERIAL-NUM 

TO BEN-CUSTOMER-ID 

TO BEN-BENEFIT-TYPE 

TO WS-DATE-TIME 



TO BEN-EFFECTIVE-DATE 



MOVE WS-MFB1-X3-MFG-SERIAL-NUM TO BEN-MFG-SERIAL-NUM 
END-EVALUATE 



PERFORM RO 50 -SELECT-CURRENT-ROW THRU 
R0 50 -SELECT-CURRENT-ROW-EXIT 



00013400 
00013400 



00079100 
00079100 



00013400 
00013400 



00079100 
00079100 



00013400 
00013400 



00079100 
00079100 



00013400 

00013400 
00013400 
00013400 
00013400 



IF WS-EDIT-OK 

MOVE BENEFITS-ROW 



TO STU-BEN-ROW 



PERFORM N000-FILL-SCREEN THRU 
N000-FILL-SCREEN-EXIT 

ELSE 

SET STC-EDIT- ERROR TO TRUE 

END-IF 

F090-DISP-PREV-ROW-EXIT. 
EXIT. 

F100-DISP-NEXT-ROW. 

* DETERMINES NEXT ROW TO BE FETCHED, FETCHES THAT ROW AND * 

* DISPLAYS ITS COLUMNS. * 



00088800 

00088800 
00088800 

00088800 

00089000 

00089400 
00136800 

00137000 
00137100 
00137200 
00137300 
00137400 



MOVE 'F100 1 TO WORK- PARA 00137500 

00136800 

PERFORM R200-STARTBR- INDICES THRU 
R200-STARTBR- INDICES-EXIT 



IF WS-EDIT-ERROR 

SET STC- EDIT- ERROR TO TRUE 00088800 

GO TO F100-DISP-NEXT-ROW-EXIT 
END-IF 



PERFORM R300-READNEXT- INDICES THRU 
R300-READNEXT- INDICES-EXIT 



MOVE WS-MFB1-KEY TO MSG30 

IF WS-EDIT-ERROR 

SET STC- EDIT -ERROR TO TRUE 00088800 

GO TO F100-DISP-NEXT-ROW-EXIT 
END-IF 



EVALUATE TRUE 
WHEN STU- INITIAL-SCREEN 
AND WS-END-SEARCH 
PERFORM R3 5 0-READPREV- INDICES THRU 
R350-READPREV-INDICES-EXIT 

00137500 

PERFORM R3 5 0-READPREV- INDICES THRU 
R3 5 0-READPREV- INDICES -EXIT 

00137500 

WHEN WS-GET-CURRENT-ROW 00014600 
AND WS-END-SEARCH 
PERFORM R3 5 0-READPREV- INDICES THRU 
R350-READPREV- INDICES-EXIT 



PERFORM R3 5 0-READPREV- INDICES THRU 
R3 50 -READPREV- INDICES- EXIT 



WHEN WS-GET-NEXT-ROW 
IF HV-SERIAL-NUM = BEN-SERIAL-NUM 

AND HV-MFG-SERIAL-NUM = BEN-MFG-SERIAL-NUM 
AND HV-CUSTOMER-ID = BEN-CUSTOMER-ID 

PERFORM R300-READNEXT- INDICES THRU 
R300-READNEXT- INDICES-EXIT 

END-IF 

IF WS-END-SEARCH 

MOVE WS-SAVE-MFB1-KEY TO WS-MFBl-KEY 00014200 

END-IF 
END- EVALUATE 



IF WS-EDIT-ERROR 

SET STC-EDIT-ERROR TO 
GO TO F100-DISP-NEXT-ROW-EXIT 

END-IF 

EVALUATE TRUE 
WHEN STU-SEARCH-SER-NUM 
MOVE WS-MFB1-X1-SERIAL-NUM 
MOVE WS-MFB1-X1-CUSTOMER-ID 



00013400 

TRUE 00088800 

00013400 
00013400 

TO BEN-SERIAL-NUM 
TO BEN-CUSTOMER-ID 



MOVE WS-MFB1 -XI -BENEFIT-TYPE TO 

MOVE WS-MFBl -XI -EFFECTIVE- DATE TO 
PERFORM Q380-X14-TO-ORA THRU 
Q380-X14-TO-ORA-EXIT 

MOVE WS-ORA-DT-TM TO 

MOVE WS-MFB1-X1-MFG-SERIAL-NUM TO 

WHEN STU-SEARCH-MFG-SER-NUM 

MOVE WS-MFB1-X2-SERIAL-NUM TO 

MOVE WS-MFB1-X2 -CUSTOMER- ID TO 

MOVE WS-MFB1-X2- BENEFIT- TYPE TO 

MOVE WS-MFB1-X2- EFFECTIVE- DATE TO 
PERFORM Q380-X14-TO-ORA THRU 
Q380-X14-TO-ORA-EXIT 

MOVE WS-ORA-DT-TM TO 

MOVE WS-MFB1-X2-MFG-SERIAL-NUM TO 

WHEN STU-SEARCH-CUST-ID 

MOVE WS-MFB1-X3-SERIAL-NUM TO 

MOVE WS-MFB1-X3-CUSTOMER-ID TO 

MOVE WS-MFB1-X3 -BENEFIT- TYPE TO 

MOVE WS-MFB1-X 3 -EFFECTIVE- DATE TO 
PERFORM Q380-X14-TO-ORA THRU 
Q380-X14-TO-ORA-EXIT 

MOVE WS-ORA-DT-TM TO 

MOVE WS-MFB1-X3-MFG-SERIAL-NUM TO 

END-EVALUATE 

PERFORM RO 50 -SELECT-CURRENT-ROW THRU 
R050 -SELECT -CURRENT- ROW-EXIT 



BEN-BENEFIT-TYPE 
WS- DATE- TIME 



BEN-EFFECTIVE-DATE 
BEN-MFG-SERIAL-NUM 



BEN-SERIAL-NUM 
BEN-CUSTOMER-ID 
BEN-BENEFIT-TYPE 
WS-DATE-TIME 



BEN-EFFECTIVE-DATE 
BEN-MFG-SERIAL-NUM 



BEN-SERIAL-NUM 
BEN-CUSTOMER-ID 
BEN-BENEFIT-TYPE 
WS-DATE-TIME 



BEN- EFFECTIVE- DATE 
BEN-MFG-SERIAL-NUM 



00079100 
00079100 



00013400 
00013400 



00079100 
00079100 



00013400 
00013400 



00079100 
00079100 



00013400 

00013400 
00013400 
00013400 



IF WS-EDIT-OK 

MOVE BENEFITS-ROW 



TO STU-BEN-ROW 



00088800 



PERFORM N000-FILL-SCREEN THRU 
N000-FILL-SCREEN-EXIT 

ELSE 

SET STC-EDIT-ERROR TO TRUE 

END-IF 

F100-DISP-NEXT-ROW-EXIT . 
EXIT. 

F2 00 -TOGGLE- HOLD . 

* TOGGLES (SETS/RESETS) BEN-HOLD-CDE SWITCH. * 



MOVE 'F200 



' TO WORK- PARA 



EVALUATE TRUE 
WHEN BEN-HOLD- THIS -BENEFIT 
PERFORM R100-SEL-UPD-CURR-ROW THRU 
R100-SEL-UPD-CURR-ROW-EXIT 
IF ORA-SQL-SUCCESSFUL 

SET BEN-NO-EXTERNAL-HOLD TO TRUE 



00088800 
00088800 

00088800 

00089000 

00089400 
00136800 

00137000 
00137100 
00137300 
00137400 
00137500 
00137400 
00137500 
00013400 
00013400 
00013400 
00013400 
00013400 



PERFORM Rl 4 0-UPD- HOLD-COLS THRU 
Rl 4 0-UPD- HOLD-COLS -EXIT 
PERFORM R150-UPDATE-CURR-ROW THRU 
R150-UPDATE-CURR-ROW-EXIT 
IF ORA-SQL-SUCCESSFUL 
EXEC SQL 

COMMIT WORK 
END-EXEC 

PERFORM Rl 4 5-UPD-HOLD-SCRN-DATA THRU 
Rl 4 5-UPD-HOLD-SCRN- DATA-EXIT 

END-IF 
ELSE 

SET WS-EDIT-ERROR 

STC -EDIT -ERROR TO TRUE 



MOVE WS-B188-NUM 

MOVE WS-B188-MSG 
END-IF 



TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 



WHEN BEN-NO- EXTERNAL- HOLD 
PERFORM R100-SEL-UPD-CURR-ROW THRU 
R100-SEL-UPD-CURR-ROW-EXIT 
IF ORA-SQL-SUCCESSFUL 

SET BEN- HOLD-TH IS -BENEFIT TO TRUE 
PERFORM R14 0-UPD-HOLD-COLS THRU 
R14 0-UPD-HOLD-COLS-EXIT 
PERFORM R150-UPDATE-CURR-ROW THRU 
R150-UPDATE-CURR-ROW-EXIT 
IF ORA-SQL-SUCCESSFUL 
EXEC SQL 

COMMIT WORK 
END-EXEC 

PERFORM R14 5-UPD-HOLD-SCRN-DATA THRU 
Rl 4 5-UPD-HOLD-SCRN- DATA-EXIT 

END-IF 
ELSE 

SET WS-EDIT-ERROR 

STC-EDIT-ERROR TO TRUE 



MOVE WS-B188-NUM 

MOVE WS-B188-MSG 
END-IF 

WHEN OTHER 
MOVE ' **NOT DEFINED *' 

SET WS-EDIT-ERROR 
STC-EDIT-ERROR 

MOVE WS-B187-NUM 

MOVE WS-B187-MSG 
MOVE BEN-HOLD-CDE 

END-EVALUATE 



TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 



TO HOLD-DESCO 



TO TRUE 



TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 
TO MSGIO (27 : 1) 



00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 



00013400 
00013400 
00063400 
00063400 
00063100 
00063200 
00063300 
00063400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 



00013400 
00013400 
00063400 
00063400 
00063100 
00063200 
00063300 
00063400 
00013400 
00013400 
00013400 
00013400 
00137400 
00063400 
00063400 
00063100 
00063200 
00063300 
00063400 

00013400 
00013400 



F2 00-TOGGLE-HOLD-EXIT . 
EXIT. 

F500-COMMIT-PROC. 
*****************************************.************************ 

* PROCESSES THE COMMIT OF ANY PREVIOUS UPDATES * 
*******************************************************.*****-***** 



MOVE 'F500 ' TO WORK- PARA 

EVALUATE TRUE 
WHEN STU-PREV-KEY-PF2 

PERFORM F2 00 -TOGGLE- HOLD THRU 
F2 00-TOGGLE-HOLD-EXIT 

END- EVALUATE 

F5 00 -COMMIT- PROC-EX IT . 
EXIT. 

F800-SET-ATTR- UPDATE . 
****************************************************************** 

***** SETS PROTECT ATTRIBUTE ON BROWSE KEY FIELDS ********* 
***************************************************************** 



MOVE 'F8 00 



' TO WORK- PARA 



MOVE X'F9' TO 

CARD-SER1A CARD-SER2A CUST-IDA MFG-SER1A MFG-SER2A 

F800-SET-ATTR-UPDATE-EXIT. 
EXIT. 

F8 1 0 -SET-ATTR-BROWSE . 
***************************************************************** 

* UNPROTECTS THE BROWSE FIELDS * 
******************************************* + ***^^.^^^ + *^^* + ^ + ^ + + + ^ 



MOVE ' F810 



TO WORK- PARA 



MOVE DFHVAL TO 

* CARD-SER1A CARD-SER2A CUST-IDA MFG-SER1A MFG-SER2A 
CARD-SER1A CARD-SER2A MFG-SER1A MFG-SER2A 

F810-SET-ATTR-BROWSE-EXIT. 
EXIT. 

/ 

M200-EDIT-SEARCH-KEY. 
***************************************************************** 

* EDITS THE FIELDS USED IN THE SEARCH KEY * 

* DETERMINES IF ANY OF THE FIELDS HAVE BEEN CHANGED * 

* A CHANGED FIELD DENOTES THE OPERATOR'S DESIRE TO SEARCH BY * 

* THAT PARTICULAR FIELD. * 
************************************************* + ***** + ******. Ar . t * 

MOVE *M200' TO WORK- PARA 



00089000 

00089400 
00136800 

00137000 
00137100 
00137300 
00137400 
00137500 
00137400 
00137500 



00137400 
00137500 
00089000 

00089400 
00136800 

*00149600 
*00149700 
*00149900 
00137400 
00137500 
00150100 
00150200 
00150300 
00089000 

00089400 
00136800 

00137000 
00137100 
00137300 
00137400 
00137500 
00137400 
00137500 
00150300 
00150300 
00089000 

00089400 
00136800 
00079100 
00137000 
00137100 
00137100 
00137100 
00137100 
00137300 
00137400 
00137500 



PERFORM M201-EDIT-SER-NUM THRU 
M201-EDIT-SER-NUM-EXIT 

PERFORM M202-EDIT-MFG-SER-NUM THRU 
M202-EDIT-MFG-SER-NUM-EXIT 

PERFORM M203-EDIT-CUST-ID THRU 
M203-EDIT-CUST-I D-EXIT 

IF WS-EDIT-OK 
EVALUATE TRUE 
WHEN BEN-SERIAL-NUM NOT = HV-SERIAL-NUM 

SET STU-SEARCH-SER-NUM TO TRUE 
SET HV-FIRST-MFG-SER-NUM TO TRUE 
SET HV-FIRST-CUST-ID TO TRUE 

WHEN BEN-MFG-SERIAL-NUM NOT = HV-MFG-SERIAL-NUM 

SET STU-SEARCH-MFG-SER-NUM TO TRUE 

SET HV-FIRST-SER-NUM TO TRUE 

SET HV-FIRST-CUST-ID TO TRUE 



WHEN 
SET 
SET 
SET 

END-EVALUATE 
END-IF 



BEN-CUSTOMER-ID NOT = HV-CUSTOMER-ID 

STU-SEARCH-CUST-ID TO TRUE 
HV-FIRST-SER-NUM TO TRUE 
HV-FIRST-MFG-SER-NUM TO TRUE 



M2 00 -EDIT- SEARCH- KEY-EX IT . 
EXIT. 

M201-EDIT-SER-NUM. 

*************************************** 

EDITS THE SERIAL NUMBER ENTERED ON THE SCREEN * 

**************************************************************** 



MOVE *M201' TO WORK- PARA 

MOVE CARD-SER1 I TO 
MOVE 5 TO 

SET NC- INTEGER-CHECK TO TRUE 
PERFORM NUMCHK-EDIT-RTN THRU 
NUMCHK-EDIT-RTN-EXIT 
IF NOT NC-NUMERIC-OK 
IF WS-EDIT-OK 

MOVE WS-B121-NUM 



NC- IN PUT- NUMBER- VAR 
NC-NUM-SIZE 



MOVE WS-B12 1-MSG 
MOVE ' SER NUM DEV #' 
MOVE -1 
END-IF 

MOVE DFHUNIMD 
SET WS -EDIT -ERROR TO 
END-IF 

IF WS-EDIT-OK 

MOVE NC-NUMBER-MASK-VAR 



TO 

TO 
TO 
TO 

TO 
TRUE 



MSGNUMO 

STC-HELP-MSG 

MSG10 

MSG10 (24 : 
CARD-SER1L 

CARD-SER1A 



15) 



TO WS-OSN-HI-5 



00137400 
00079100 
00079100 
00137400 
00079100 
00079100 
00137400 
00079100 
00079100 
00137400 
00079100 
00079100 
00079100 
00079100 
00079100 
00079100 
00137400 
00079100 
00079100 
00079100 
00079100 
00137400 
00079100 
00079100 
00079100 
00079100 
00079100 
00079100 
00089000 
00079100 
00089400 
00136800 
00079100 
00137000 
00137100 
00137300 
00137400 
00137500 
00137400 
00275300 
00275400 
00275500 
00275600 
00275700 
00275800 
00275900 
00276000 
00276100 
00276300 
00276300 
00276500 
00276600 
00276700 
00276800 
00275800 
00275900 
00275900 



END-IF 

MOVE CARD-SER2I 
MOVE 10 
SET NC- INTEGER-CHECK TO TRUE 
PERFORM NUMCHK-EDIT-RTN THRU 
NUMCHK-EDIT-RTN-EXIT 
IF NOT NC-NUMERIC-OK 
IF WS-EDIT-OK 

MOVE WS-B121-NUM 



TO NC- IN PUT -NUMBER- VAR 
TO NC-NUM-SIZE 



TO 

TO 
TO 
TO 

TO 
TRUE 



MSGNUMO 
STC-HELP-MSG 
MSGIO 

MSGIO (24 : 
CARD-SER2L 

CARD-SER2A 



15) 



TO WS-OSN-LO-10 
TO HV-SERIAL-NUM 



MOVE WS-B121-MSG 
MOVE 1 SER NUM GMT ' 
MOVE -1 
END-IF 

MOVE DFHUNIMD 
SET WS -ED IT- ERROR TO 
END-IF 

IF WS-EDIT-OK 

MOVE NC-NUMBER-MASK-VAR 

MOVE WS-SERIAL-NUM-X15 
END-IF 

M201-EDIT-SER-NUM-EXIT . 
EXIT. 

/ 

M202-EDIT-MFG-SER-NUM. 
* EDITS THE MANUFACTURER'S SERIAL NUMBER * 



MOVE 'M202' TO WORK-PARA 

MOVE MFG-SER1I 
MOVE 3 

SET NC- INTEGER-CHECK TO TRUE 
PERFORM NUMCHK-EDIT-RTN THRU 
NUMCHK-EDIT-RTN-EXIT 
IF NOT NC-NUMERIC-OK 
IF WS-EDIT-OK 

MOVE WS-B121-NUM 

MOVE WS-B12 1-MSG 
MOVE ' MFG NUM # 
MOVE -1 
END-IF 

MOVE DFHUNIMD TO 
SET WS -EDIT- ERROR TO TRUE 
END-IF 

IF WS-EDIT-OK 

MOVE NC-NUMBER-MASK-VAR 
END-IF 



TO NC- INPUT -NUMBER- VAR 
TO NC-NUM-SIZE 



TO 

TO 
TO 
TO 



MSGNUMO 

STC-HELP-MSG 

MSGIO 

MSGIO (24 : 15) 
MFG-SER1L 

MFG-SER1A 



TO WS-MSN-HI-3 



MOVE MFG-SER2 I 
MOVE 8 
SET NC- INTEGER-CHECK TO TRUE 
PERFORM NUMCHK-EDIT-RTN THRU 



TO NC- INPUT-NUMBER- VAR 
TO NC-NUM-SIZE 



00275900 
00137400 
00275300 
00275400 
00275500 
00275600 
00275700 
00275800 
00275900 
00276000 
00276100 
00276300 
00276300 
00276500 
00276600 
00276700 
00276800 
00275800 
00275900 
00275900 
00275900 
00275900 
00089000 
00079100 
00089400 
00136800 
00079100 
00137000 
00137100 
00137300 
00137400 
00137500 
00137400 
00275300 
00275400 
00275500 
00275600 
00275700 
00275800 
00275900 
00276000 
00276100 
00276300 
00276300 
00276500 
00276600 
00276700 
00276800 
00275800 
00275900 
00275900 
00275900 
00137400 
00275300 
00275400 
00275500 
00275600 



NUMCHK-EDIT-RTN-EXIT 



IF NOT NC-NUMERIC-OK 
IF WS-EDIT-OK 

MOVE WS-B121-NUM 

MOVE WS-B121-MSG 
MOVE ' MFG SERIAL# 
MOVE -1 
END- IF 

MOVE DFHUNIMD 
SET WS- EDIT- ERROR TO 
END-IF 

IF WS-EDIT-OK 

MOVE NC -NUMBER-MASK- VAR 



TO 

TO 
TO 
TO 

TO 
TRUE 



MSGNUMO 
STC-HELP-MSG 
MSGIO 
MSGIO (24 
MFG-SER2L 

MFG-SER2A 



15) 



TO WS-MSN-LO-8 



MOVE WS-MFG-SERIAL-NUM-X11 TO HV-MFG-SERIAL-NUM 
END-IF 

M202-EDIT-MFG-SER-NUM-EXIT . 
EXIT. 

M203-EDIT-CUST-ID. 

* EDITS THE CUSTOMER ID * 

MOVE 'M203' TO WORK- PARA 



MOVE CUST-IDI 

PERFORM VARYING I FROM 1 BY 
UNTIL I > 14 
IF WS-CI-CHAR (I) - SPACE 
IF WS-EDIT-OK 

MOVE WS-B121-NUM 



MOVE WS-B121-MSG 
MOVE 'CUSTOMER ID ' 
MOVE -1 
END-IF 

MOVE DFHUNIMD 
SET WS -EDIT -ERROR TO 
MOVE 15 
END-IF 
END- PERFORM 

IF WS-EDIT-OK 

MOVE WS-CUSTOMER-ID-X14 
END-IF 



TO WS - CUSTOMER- I D-X 14 



TO 

TO 
TO 
TO 



TO 
TRUE 
TO 



MSGNUMO 

STC-HELP-MSG 

MSGIO 

MSGIO (24 : 
CUST-IDL 

CUST-IDA 



15) 



TO HV-CUSTOMER-ID 



/ 



M203-EDIT-CUST- ID-EXIT. 
EXIT. 

NOOO-FILL-SCREEN. 

* THIS PARAGRAPH CONTROLS ALL PROCESSING RELATED TO DATA MOVE- * 

* MENT TO THE SCREEN AREA. * 



00275700 
00275800 
00275900 
00276000 
00276100 
00276300 
00276300 
00276500 
00276600 
00276700 
00276800 
00275800 
00275900 
00275900 
00275900 
00275900 
00089000 
00079100 
00089400 
00136800 
00079100 
00137000 
00137100 
00137300 
00137400 
00137500 
00137400 
00275900 
00275900 
00275900 
00275900 
00275900 
00276000 
00276100 
00276300 
00276300 
00276500 
00276600 
00276700 
00276800 
00276800 
00275800 
00275900 
00137400 
00275900 
00275900 
00275900 
00089000 
00079100 
00089400 
00136800 
00136900 
00137000 
00137100 
00137200 
00137300 
00137400 



MOVE 'N000' TO WORK- PARA 

MOVE BEN-SN-DEV-NUM 

MOVE WS-DISP-NUM-5 

MOVE BEN-SN-GMT 

MOVE WS-DIS P-NUM- 1 0 

MOVE BEN-CUSTOMER- I D 



TO WS-DISP-NUM- 

TO CARD-SERIO 

TO WS-DISP-NUM- 

TO CARD-SER20 

TO CUST-IDO 



10 



MOVE BEN-EFFECTIVE- DATE TO 
PERFORM Q300-GET-DISP-DATE THRU 
Q300-GET-DISP-DATE-EXIT 



MOVE WS-DATE-DISP-10 
MOVE WS-TIME-DISP-8 

MOVE BEN-BENEFIT-TYPE 
EVALUATE TRUE 
WHEN BEN-METRO-CHECK 
MOVE ' METRO CHECK 



TO 
TO 



WS-ORA-DT-TM 



EFF-DATEO 
EFF-TIMEO 



TO BEN-TYPEO 



TO BEN-DESCO 



TO BEN-DESCO 
TO BND-BENEFIT-DESC 



WHEN OTHER 
MOVE ' NOT DEFINED 1 
END-EVALUATE 
MOVE ' * NOT DEFINED * ' 
EXEC SQL SELECT 
BENEFIT_DESC 
INTO 

: BND-BENEFIT-DESC 
FROM MCHECK. BENEFITS_DEFINITION 
WHERE 

BENEFIT_TYPE = RPAD (: BEN-BENEFIT-TYPE, 5 , 1 ') 
END-EXEC 

MOVE BND-BENEFIT-DESC-ARR TO BEN-DESCO 



00137500 
00137400 



00137400 
00137400 



00137400 

00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 



MOVE BEN-MFG-SERIAL-NUM (1 
MOVE BEN-MFG-SERIAL-NUM (4 



3) TO MFG-SERIO 
8) TO MFG-SER20 



MOVE ZERO TO 

MOVE BEN-LAST-AUTH-SEQ-NUM TO 

MOVE WS-BIN-2N TO 

MOVE WS-COMP-DISP-4 TO 



WS-BIN-2N 
WS-B2-LO 
WS-COMP-DISP-4 
AUTH-CDEO 



MOVE BEN-LOAD- DT-TM 
PERFORM Q300-GET-DISP-DATE THRU 
Q3 0 0 -GET- DISP- DATE-EX IT 
MOVE WS-DATE-DISP-10 TO 
MOVE WS-TIME-DISP-8 TO 



TO WS-ORA-DT-TM 



LOAD- DAT EO 
LOAD-TIMEO 



MOVE BEN-EXPIRATION-DATE TO 

PERFORM Q300-GET- DISP- DATE THRU 
Q3 00 -GET- DISP- DATE- EXIT 

MOVE WS-DATE-DISP-10 TO 

MOVE WS-TIME-DISP-8 TO 

MOVE BEN- INITIAL-VAL-AMT TO 

MOVE WS-DISP-DEC-FMT-5 TO 



WS-ORA-DT-TM 



EXP-DATEO 
EXP-TIMEO 

WS-DISP-DEC-FMT-5 
INIT-AMTO 



00137400 
00013400 
00013400 
00137400 



MOVE BEN-REM-VAL-AMT 
MOVE WS-DISP-DEC-FMT-5 



TO WS-DISP-DEC-FMT-5 
TO REM-AMTO 



MOVE BEN- LAST -CLAIM- HOLD-CDE TO 
EVALUATE TRUE 
WHEN BEN-ON-HOLD-PREV-EUB2 
MOVE T ==> ON HOLD 



WHEN BEN-AVAILABLE 
MOVE * AVAILABLE 

WHEN OTHER 
MOVE '**UNKNOWN CODE*' 

END-EVALUATE 

MOVE BEN-LAST-CLAIM- VAL-AMT 
MOVE WS - DI S P- DEC-FMT - 5 



TO 
TO 



MOVE BEN-LAST-CLAIM- DT-TM TO 
PERFORM Q300-GET-DISP-DATE THRU 
Q300-GET-DISP-DATE-EXIT 

MOVE WS-DATE-DISP-10 TO 

MOVE WS-TIME-DISP-8 TO 

MOVE BEN-LAST-AUTH-CDE TO 

MOVE BEN-LAST-RETR-REF-NUM TO 

MOVE BEN-LAST-REQUEST-TYPE TO 
EVALUATE TRUE 
WHEN BEN- BENEFIT-LOADED 

MOVE 'INITIAL LOAD ' TO 

WHEN BEN- BENEFIT -REQUEST 

MOVE ! EUB1 BEN REQST ' TO 



WHEN BEN-CLAIM-CONFIRM 
MOVE ' EUB5 CLM CONFRM 1 



WHEN BEN- HOLD-ALL-CUST- BENEFITS 
MOVE 1 EUB5 CLM CREDIT' TO 



WHEN OTHER 
MOVE ' NOT DEFINED 
END-EVALUATE 



MOVE BEN-LAST-REQUEST-DT-TM TO 
PERFORM Q30 0 -GET- DISP- DATE THRU 
Q300-GET-DISP- DATE-EX IT 
MOVE WS-DATE-DISP-10 TO 
MOVE WS-TIME-DISP-8 TO 



MOVE BEN- HOLD-CDE 
EVALUATE TRUE 
WHEN BEN-NO-EXTERNAL-HOLD 
MOVE ' AVAILABLE ' TO 



EVHLDCDEO 



TO EVHLDDESCO 



TO EVHLDDESCO 



TO EVHLDDESCO 



WS-DISP-DEC-FMT-5 
LCLM-AMTO 

WS-ORA-DT-TM 



LCLM-DATEO 
LCLM-TIMEO 

AUTH-CDEO 

RETREFNUMO 

LREQ-TYPEO 

LREQ-DESCO 

LREQ-DESCO 



TO LREQ-DESCO 



LREQ-DESCO 



TO LREQ-DESCO 



WS-ORA-DT-TM 



LREQ-DATEO 
LREQ-TIMEO 



TO HOLD-STO 



HOLD-DESCO 



00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00137400 
00013400 
00013400 
00137400 



00013400 

00137400 

00137400 

00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00137400 



00013400 
00013400 
00013400 
00013400 
00013400 



WHEN BEN -HOLD- THIS -BENEFIT 
MOVE 'HOLD - SER # 



TO HOLD-DESCO 



WHEN BEN -HOLD-ALL-CUST- BENEFITS 
MOVE 'HOLD - CUSTOMER' TO 



HOLD-DESCO 



WHEN OTHER 
MOVE ' NOT DEFINED 
END- EVALUATE 



TO HOLD-DESCO 



MOVE BEN-HOLD-DT-TM TO 
PERFORM Q3 0 0 -GET- DISP- DATE THRU 
Q300-GET-DISP- DATE-EXIT 
MOVE WS-DATE-DISP-10 TO 
MOVE WS-TIME-DISP-8 TO 



MOVE BEN-HOLD-USER-ID 



TO 



MOVE BEN-UPDATE-DT-TM TO 
PERFORM Q300 -GET- DISP- DATE THRU 
Q300 -GET- DISP- DATE-EXIT 



MOVE WS-DATE-DISP-10 
MOVE WS-TIME-DISP-8 

MOVE BEN-UPDATE-ACTION-CDE 
EVALUATE TRUE 
WHEN BEN-NO-UPDATES 
MOVE ' INITIAL STATUS ' 

WHEN BEN -HOLD-TH IS -BENEFIT 
MOVE 'UPD BEN TYPE 



TO 
TO 



WS-ORA-DT-TM 

HOLD-DATEO 
HOLD-TIMEO 

HOLD-UIDO 

WS-ORA-DT-TM 



UPD-DATEO 
UPD-TIMEO 



TO UPD-CDEO 



TO UPD-DESCO 



TO UPD-DESCO 



WHEN BEN -HOLD-ALL-CUST- BENEFITS 



MOVE 'UPD INITIAL VAL ' 

WHEN OTHER 
MOVE ' NOT DEFINED 1 
END- EVALUATE 

MOVE BEN- UPDATE-USER- ID 

MOVE ZERO 

MOVE BEN-LAST-AUTH-SEQ-NUM 

MOVE WS-BIN-2N 

MOVE WS-DISP-2Z9 (3 : 1) 

NOOO-FILL-SCREEN-EXIT . 
EXIT. 



/ 

Q000-SQLCODE-PROCESS . 
**************************************** 



TO UPD-DESCO 



TO UPD-DESCO 



TO UPD-UIDO 

TO WS-BIN-2N 

TO WS-B2-LO 

TO WS-DISP-ZZ9 

TO ASEQ-NUMO 



00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 



00137400 
00013400 



INTERPETS ERROR AND DISPLAYS ON SCREEN » uuu/iuu 

★*************+*******+****^ 00137300 



00013400 

00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00137400 

00137400 



00141200 
00141300 
00141400 

00136800 
00136900 
00137000 
* 00137100 



MOVE 'Q000* TO WORK- PARA 



00137400 
00137500 



MOVE SPACES 
MOVE SQLCODE 

EVALUATE TRUE 
WHEN ORA-SQL-SUCCESSFUL 
CONTINUE 

WHEN ORA-SQL-ROW-NOT-FOUND 
PERFORM Q030-NOT-FOUND THRU 
Q030 -NOT- FOUND- EX IT 

WHEN OTHER 
PERFORM Q020- SQL-ERROR THRU 
Q020- SQL-ERROR-EXIT 

END-EVALUATE 



TO SQLERRMC 
TO ORA- NAMED- SQLCODE 
ORA-SQLCODE-DISP-4 



00137400 
00073500 
00073500 
00073600 

00073800 
00063400 
00063400 
00073900 
00063400 
00063400 
00063400 

00063400 
00063400 
00063400 



Q000-SQLCODE-PROCESS-EXIT . 
EXIT. 



00136900 



/ 

Q020-SQL-ERROR. 

***************************************************************** 

* INTERPETS ERROR AND DISPLAYS ON SCREEN * 
***************************************************************** 



SET WS -EDIT- ERROR 
STC-EDIT -ERROR 

MOVE WS-B18 1-NUM 

MOVE WS-B181-MSG 
MOVE SQLCODE 
MOVE WS-SQLCODE-DISP 
MOVE WORK- PARA 
MOVE SQLERRMC 

Q020-SQL-ERROR-EXIT . 
EXIT . 



TO TRUE 



TO MSGNUMO 

STC-HELP-MSG 

TO MSGIO 

TO WS-SQLCODE-DISP 

TO MSGIO {11 : 5) 

TO MSGIO (23 : 8) 

TO MSG30 



00136800 
00136900 
00137000 
00137100 
00137300 
00137400 
00063400 
00063400 
00063100 
00063200 
00063300 
00063400 



Q030-NOT-FOUND. 
************************************ 

* NOT FOUND PROCESSING * 
***************************************************************** 



MOVE 'Q030' TO WORK- PARA 
SET WS -EDIT- ERROR 
MOVE WS-B191-NUM 
MOVE WS-B191-MSG 



TO TRUE 



TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 



MOVE 'Q030 NOT FOUND 
MOVE BEN-SERIAL-NUM 
MOVE WORK- PARA 



TO MSGIO 

TO MSGIO (17 : 15) 
TO MSGIO (34 : 8) 



QO 30 -NOT -FOUND-EX IT . 
EXIT. 

/ 

Q300-GET-DISP-DATE. 
***************************************************************** 

* INTERPETS ERROR AND DISPLAYS ON SCREEN * 
***************************************************************** 



MOVE T Q300 



TO WORK- PARA 



MOVE 


WS-ODT-BYTE (1) 






TO 


ws- 


B2 


-LO 


SUBTRACT 100 FROM WS 


-BIN- 


2N 










MOVE 


WS-BIN-2N 








w o 


V 1 




MOVE 


WS-ODT-BYTE (2) 






TO 


ws- 


B2' 


-LO 


SUBTRACT 100 FROM WS 


-BIN- 


2N 










MOVE 


WS-BIN-2N 






TO 


ws- 


DT' 


-YY 


MOVE 


WS-ODT-BYTE (3) 






TO 


ws- 


B2' 


-LO 


MOVE 


WS-BIN-2N 






TO 


ws- 


DT' 


-MM 


MOVE 


WS-ODT-BYTE (4) 






TO 


ws- 


■B2- 


-LO 


MOVE 


WS-BIN-2N 






TO 


ws- 


■DT- 


-DD 


MOVE 


WS-ODT-BYTE (5) 






TO 


ws- 


■B2- 


-LO 


SUBTRACT 1 FROM WS 


-BIN- 


■2N 










MOVE 


WS-BIN-2N 






TO 


ws- 


■DT- 


-HH 


MOVE 


WS-ODT-BYTE (6) 






TO 


ws- 


■B2- 


-LO 


SUBTRACT 1 FROM WS 


-BIN- 


■2N 










MOVE 


WS-BIN-2N 






TO 


ws- 


•DT' 


-MI 


MOVE 


WS-ODT-BYTE (7) 






TO 


ws- 


■B2- 


-LO 


SUBTRACT 1 FROM WS 


-BIN- 


■2N 










MOVE 


WS-BIN-2N 






TO 


ws- 


■DT- 


-ss 


MOVE FOR 


SCREEN DISPLAYS 














MOVE 


WS-DT-CC 






TO 


ws- 


DD- 


-CC 


MOVE 


WS-DT-YY 






TO 


ws- 


DD- 


-YY 


MOVE 


WS-DT-MM 






TO 


ws- 


DD- 


-MM 


MOVE 


WS-DT-DD 






TO 


ws- 


DD- 


-DD 


MOVE 


WS-DT-HH 






TO 


ws- 


TD- 


-HH 


MOVE 


WS-DT-MI 






TO 


ws- 


TD- 


-MI 


MOVE 


WS-DT-SS 






TO 


ws- 


TD- 


-ss 



Q3 0 0 -GET- DISP- DATE- EXIT . 
EXIT. 



Q350-DISP-TO-ORA. 

***** CONVERT DISPLAY DATE/TIME TO ORACLE DATE ****** 
************************************************************** 



* MOVE 'Q350' 

* MOVE FOR SCREEN DISPLAYS 



TO 



WORK- PARA. 



MOVE 


WS-DD-CC 


TO 


WS-DT-CC 


MOVE 


WS-DD-YY 


TO 


WS-DT-YY 


MOVE 


WS-DD-MM 


TO 


WS-DT-MM 


MOVE 


WS-DD-DD 


TO 


WS-DT-DD 


MOVE 


WS-TD-HH 


TO 


WS-DT-HH 


MOVE 


WS-TD-MI 


TO 


WS-DT-MI 


MOVE 


WS-TD-SS 


TO 


WS-DT-SS 



0 
0 
0 

00136800 

00137000 
00137100 
00137300 
00137400 
00063400 
00064600 
00064700 
00064800 
00064900 
00065000 
00065100 
00065200 
00065300 
00065400 
00065500 
00065600 
00065700 
00064800 
00065800 
00065900 
00064800 
00066000 
00066100 
00064800 
00066200 
00137400 

00066200 
00066200 
00066200 
00066200 
00066200 
00066200 
00066200 



00079100 



00137400 

00066200 
00066200 
00066200 
00066200 
00066200 
00066200 
00066200 



PERFORM Q380-X14-TO-ORA THRU 
Q380-X14-TO-ORA-EXIT 



00064600 
00079100 
00079100 



Q350-DISP-TO-ORA-EXIT . 
EXIT. 



00079100 



Q380-X14-TO-ORA. 
+**********++******************************^ 

***** CONVERT XI 4 DATE FORMAT TO ORACLE DATE ****** 



************************************************************** 


* MOVE 


1 Q380 ' 


TO 


WORK- PARA . 




* CONVERT 


THE FIELDS 








MOVE 


ZERO 


TO 


WS-BIN-2N 




MOVE 


WS-DT-CC 


TO 


WS-BIN-2N 




ADD 


100 TO 


WS-BIN-2N 






MOVE 


WS-B2-LO 


TO 


WS-ODT-BYTE 


(1) 


MOVE 


ZERO 


TO 


WS-BIN-2N 




MOVE 


WS-DT-YY 


TO 


WS-BIN-2N 




ADD 


100 TO 


WS-BIN-2N 






MOVE 


WS-B2-LO 


TO 


WS-ODT-BYTE 


(2) 


MOVE 


ZERO 


TO 


WS-BIN-2N 




MOVE 


WS-DT-MM 


TO 


WS-BIN-2N 




MOVE 


WS-B2-LO 


TO 


WS-ODT-BYTE 


(3) 


MOVE 


WS-DT-DD 


TO 


WS-BIN-2N 




MOVE 


WS-B2-LO 


TO 


WS-ODT-BYTE 


(4) 


MOVE 


WS-DT-HH 


TO 


WS-BIN-2N 




ADD 


1 TO 


WS-BIN-2N 






MOVE 


WS-B2-LO 


TO 


WS-ODT-BYTE 


(5) 


MOVE 


WS-DT-MI 


TO 


WS-BIN-2N 




ADD 


1 TO 


WS-BIN-2N 






MOVE 


WS-B2-LO 


TO 


WS-ODT-BYTE 


(6) 


MOVE 


WS-DT-SS 


TO 


WS-BIN-2N 




ADD 


1 TO 


WS-BIN-2N 






MOVE 


WS-B2-LO 


TO 


WS-ODT-BYTE 


(7) 


Q380-X14- 


TO-ORA-EXIT. 








EXIT. 










R0 50 -SELECT-CURRENT-ROW . 








************************************************************** 



00079100 



00064600 

00064700 
00064700 
00064800 
00064700 
00064700 
00064700 
00064800 
00064700 
00064700 
00065300 
00065300 
00065300 
00065300 
00065300 
00064800 
00065300 
00065300 
00064800 
00065300 
00065300 
00064800 
00065300 

00079100 



00013400 



***** SELECTS ROW USING THE CURRENT SCREENS KEY ****** 

************************************************************** 



MOVE 'R050' 



TO 



WORK- PARA . 



* SELECT CURRENT ROW FROM BENEFITS 
EXEC SQL SELECT 
-INC CWELB800 

INTO 

■INC CWELB805 

FROM MCHECK. BENEFITS 
WHERE SERIAL_NUM 
AND CUSTOMER_ID 
AND BENEFIT_TYPE 
AND EFFECTIVE DATE 



= RPAD ( : BEN-SERIAL-NUM, 15 , ' ' ) 

= RPAD (: BEN-CUSTOMER-ID, 14, ' ') 

= RPAD ( : BEN-BENEFIT-TYPE, 5 , 1 1 ) 

= : BEN-EFFECTIVE -DATE 



00013400 



00013400 



END- EXEC 



PERFORM Q000-SQLCODE-PROCESS THRU 00136900 
Q000-SQLCODE-PROCESS-EXIT 00136900 

IF NOT ORA-SQL-SUCCESSFUL 00073800 
SET WS -EDIT- ERROR TO TRUE 00136900 
END-IF 00073800 

R050-SELECT-CURRENT-ROW-EXIT. 000134 00 

EXIT. 

R100-SEL-UPD-CURR-ROW. 000134 00 

************************************************************** 

***** SELECTS AND UPDATES THE CURRENT ROW ON BENEFITS ****** 
***************-k********************************************** 

* MOVE 'R100' TO WORK- PARA. 

* SELECT CURRENT ROW WITH UPDATE FROM BENEFITS 

EXEC SQL SELECT 

-INC CWELB800 % 
INTO 

-INC CWELB805 % 
FROM MCHECK . BENEFITS 
WHERE SERIAL_NUM = RPAD ( 

AND CUSTOMER_ID = RPAD ( 

AND BENEFIT TYPE = RPAD ( 



BEN-SERIAL-NUM, 15, 1 ' ) 
BEN-CUSTOMER-ID, 14 , ' ) 
BEN-BENEFIT-TYPE, 5, ' ') 00013400 
AND EFFECT I VE_DATE - : BEN-EFFECTIVE-DATE 
FOR UPDATE OF 00017200 



-INC CWELB800 % 
END-EXEC 

PERFORM Q000-SQLCODE-PROCESS THRU 00136900 

Q000-SQLCODE- PROCESS-EXIT 00136900 

IF NOT ORA-SQL-SUCCESSFUL 00073800 
SET WS- EDIT- ERROR TO TRUE 00136900 
END-IF 00073800 

R100-SEL-UPD-CURR-ROW-EXIT . 00013400 
EXIT. 

Rl 4 0-UPD- HOLD-COLS . 
********************************* + ******* + * + + + * + * + + ** + + + + + + **+. 

***** MOVE HOLD CONTROL DATA TO HOLD COLUMNS ****** 
************************************************************** 

* MOVE 'R14 0' TO WORK- PARA. 



MOVE STU-USER-ID TO BEN-HOLD-USER- I D 

EXEC SQL SELECT 

SYS DATE INTO : WS-PROCESS-DATE 
FROM DUAL 
END-EXEC 

MOVE WS-PROCESS-DATE TO BEN-HOLD-DT-TM 



00062900 



R14 0-UPD-HOLD-COLS-EXIT . 
EXIT. 

Rl 4 5-UPD-HOLD-SCRN-DATA. 
************************************************************** 

***** M ovE HOLD CONTROL DATA TO HOLD COLUMNS ****** 
************************************************************** 

* MOVE * R14 5' TO WORK- PARA. 



MOVE BENEFITS-ROW 
MOVE -I 



TO STU-BEN-ROW 
TO CARD-SER1L 



00088800 
00065200 



MOVE BEN-HOLD-CDE 
EVALUATE TRUE 
WHEN BEN-NO- EXTERNAL-HOLD 
MOVE ' AVAILABLE ' ' 

WHEN BEN-HOLD-THIS-BENEFIT 
MOVE 'HOLD - SER # ' 



TO HOLD-STO 



TO HOLD-DESCO 



TO HOLD-DESCO 



WHEN BEN-HOLD- ALL-CUST-BENE FITS 
MOVE 'HOLD - CUSTOMER 1 TO 



WHEN OTHER 
MOVE ' NOT DEFINED 
END- EVALUATE 



MOVE BEN- HOLD- DT-TM TO 
PERFORM Q300-GET-DISP-DATE THRU 
Q300-GET-DISP-DATE-EXIT 
MOVE WS-DATE-DISP-10 TO 
MOVE WS-TIME-DISP-8 TO 



HOLD-DESCO 



TO HOLD-DESCO 



WS-ORA-DT-TM 



HOLD-DATEO 
HOLD-TIMEO 



00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 
00013400 



00137400 



MOVE BEN-HOLD-USER- ID 



TO HOLD-UIDO 



Rl 4 5-UPD-HOLD-SCRN-DATA- EXIT . 
EXIT. 



R150-UPDATE-CURR-ROW . 



************************************************************** 

***** UPDATES THE SELECTED BENEFITS ROW ****** 
************************************************************** 



MOVE 'R150' 



TO 



WORK- PARA. 



EXEC SQL UPDATE MCHECK . BENEFITS 
SET 

HOLD_DT_TM 
HOLD_CDE 
HOLD_USER_ID 
WHERE 

SERIAL_NUM 
AND CUSTOMER_ID 
AND BENEFIT_TYPE 
AN D EFFECTI VE_DAT E 
END-EXEC 



BEN- HOLD- DT-TM, 
BEN-HOLD-CDE, 
BEN-HOLD-USER- ID 

RPAD ( : BEN-SERIAL-NUM, 1 5 , ' ') 
RPAD (: BEN-CUSTOMER-ID, 14, ' ' ) 
RPAD ( : BEN-BENEFIT- TYPE , 5, ' 1 ) 
: BEN-EFFECTIVE-DATE 



00036600 
00036600 



00036600 
00036600 
00036600 
00013400 
00036600 
00036600 



PERFORM Q000-SQLCODE-PROCESS THRU 



00136900 



QOOO-SQLCODE-PROCESS-EXIT 



00136900 



IF NOT ORA-SQL-SUCCESSFUL 00073800 
SET WS- EDIT -ERROR TO TRUE 00136900 
END-IF 00073800 

R150-UPDATE-CURR-ROW-EXIT . 
EXIT. 



R200-STARTBR- INDICES . 
***** ROUTINE TO START BROWSE BENEFIT INDICES **** 

****************************************************************** 

MOVE ' R200' TO WORK- PARA 



TO 
TO 
TO 
TO 



EVALUATE TRUE 
WHEN STU-SEARCH-SER-NUM 
SET WS-MFB1-NDX-SERIAL-NUM 
MOVE BEN-SERIAL-NUM 
MOVE BEN-CUSTOMER-ID 
MOVE BEN- BENE FIT -TYPE 
MOVE BEN-EFFECTIVE-DATE 
PERFORM Q300-GET-DISP-DATE THRU 
Q3 00 -GET-DISP- DATE-EX IT 
MOVE WS- DATE -TIME TO 
MOVE BEN-MFG-SERIAL-NUM TO 
MOVE WS-MFB1-KEY TO 



TRUE 

WS-MFB1-X1-SERIAL-NUM 
WS-MFB1-X1-CUSTOMER-ID 
WS-MFB1 -XI -BENE FIT- TYPE 



TO WS-ORA-DT-TM 



WS-MFB1 -XI -EFFECTIVE- DATE 
WS-MFB1-X1-MFG-SERIAL-NUM 
WS-SAVE-MFB1-KEY 



WHEN STU-SEARCH-MFG-SER-NUM 
SET WS -MFB1-NDX-MFG- SERIAL - 
MOVE BEN-SERIAL-NUM 
MOVE BEN-CUSTOMER-ID 
MOVE BEN-BENEFIT-TYPE 
MOVE BEN-EFFECTIVE- DATE 
PERFORM Q3 00 -GET-DISP- DATE 
Q3 00 -GET-DISP- DATE- 
MOVE WS- DATE-TIME 
MOVE BEN-MFG-SERIAL-NUM 
MOVE WS-MFB1-KEY 



NUM TO TRUE 

TO WS-MFB1-X2-SERIAL-NUM 

TO WS-MFB1-X2- CUSTOMER- ID 

TO WS-MFB1-X2- BENEFIT- TYPE 

TO WS-ORA-DT-TM 

THRU 

EXIT 

TO WS-MFB1-X2 -EFFECTIVE- DATE 
TO WS-MFB1-X2-MFG-SERIAL-NUM 
TO WS-SAVE-MFB1-KEY 



WHEN STU-SEARCH-CUST-ID 
SET WS-MFB1-NDX-CUSTOMER-I 
MOVE BEN-SERIAL-NUM 
MOVE BEN-CUSTOMER-ID 
MOVE BEN-BENEFIT- TYPE 
MOVE BEN- EFFECTIVE- DATE 
PERFORM Q3 00 -GET-DISP- DATE 
Q300-GET-DISP-DATE 
MOVE WS -DATE- TIME 
MOVE BEN-MFG-SERIAL-NUM 
MOVE WS-MFB1-KEY 
END-EVALUATE 



) TO TRUE 

TO WS-MFB1-X3-SERIAL-NUM 

TO WS-MFB1-X 3 -CUSTOMER- ID 

TO WS-MFB1-X 3 -BENEFIT-TYPE 

TO WS-ORA-DT-TM 

THRU 

EXIT 

TO WS-MFB1-X3 -EFFECTIVE- DATE 

TO WS-MFB1-X3-MFG-SERIAL-NUM 

TO WS-SAVE-MFB1-KEY 



EXEC CICS 

STARTBR 

FILE ( ' DEFMFB1 ' ) 
RIDFLD (WS-MFB1-KEY) 



GTEQ 

RESP (WS-RESP) 
END-EXEC . 

SET WS-STARTBR TO TRUE 
PERFORM R2 80 -CHECK- RESP THRU 
R2 8 0 -CHECK- RESP- EXIT 

R200-STARTBR- INDICES-EXIT . 
EXIT. 

R2 8 0 -CHECK- RESP . 

******************************************************** 

**** CHECKS WS-RESP FOR GOOD FUNCTION 
*********************************** 

MOVE 'B280' TO WORK- PARA 



EVALUATE TRUE 
WHEN WS-RESP - D FH RES P ( NORMAL) 
EVALUATE TRUE 
WHEN STU-SEARCH-SER-NUM 

IF NOT WS-MFB1-NDX-SERIAL-NUM 
PERFORM R2 8 5-END-OF-SEARCH THRU 
R2 8 5 -END-OF- SEARCH-EX IT 

END-IF 



WHEN STU-SEARCH-MFG-SER-NUM 

IF NOT WS-MFB1-NDX-MFG-SERIAL-NUM 
PERFORM R28 5-END-OF-SEARCH THRU 
R28 5-END-OF-SEARCH-EXIT 

END-IF 



WHEN STU-SEARCH-CUST-ID 

IF NOT WS-MFB1-NDX-CUSTOMER-ID 
PERFORM R28 5-END-OF-SEARCH THRU 
R28 5-END-OF-SEARCH-EXIT 

END-IF 



WHEN OTHER 

SET WS-EDIT-ERROR TO TRUE 

MOVE WS-B190-NUM TO MSGNUMO 

STC-HELP-MSG 

MOVE WS-B190-MSG TO MSGIO 

MOVE STU- SEARCH -FLAG TO MSGIO (22 : 1 
END-EVALUATE 



WHEN WS-RESP = DFHRESP (NOTFND) 
WHEN WS-RESP = DFHRESP ( ENDFILE ) 
PERFORM R2 8 5-END-OF-SEARCH THRU 
R2 8 5-END-OF-SEARCH-EXIT 



WHEN OTHER 
SET WS-EDIT-ERROR 
MOVE WS-B18 9-NUM 

MOVE WS-B18 9-MSG 
MOVE WS-RESP 



TO TRUE 

TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 

TO WS-SQLCODE-DISP 



MOVE 


WS-SQLCODE-DISP 


TO 


MSGIO 


(18 


: 5) 


MOVE 


WORK- PARA 


TO 


MSGIO 


(30 


: 8) 


MOVE 


WS-FUNCTION-ID 


TO 


MSGIO 


(39 


: 9) 


MOVE 


' KEY : 1 


TO 


MSG30 






MOVE 


WS-MFB1-KEY 


TO 


MSG30 


(6 : 


40) 



END- EVALUATE 



R280-CHECK-RESP-EXIT. 
EXIT . 



R285-END-OF-SEARCH. 
****************************************************************** 

***** SETS END OF SEARCH CONDITION INCLUDING MESSAGE ******* 
****************************************************************** 

* MOVE 'R285' TO WORK- PARA 



SET WS- END- SEARCH TO TRUE 



MOVE WS-B180-NUM 



MOVE WS-B180-MSG 



TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 



00063200 
00063300 



EVALUATE TRUE 
WHEN WS-GET-NEXT-ROW 
WHEN STU-INITIAL-SCREEN 
WHEN WS-GET-CURRENT-ROW 
MOVE 1 LAST ' 

WHEN WS-GET- PREVIOUS-ROW 
MOVE 'FIRST' 

WHEN OTHER 
MOVE 'OTHER' 
END-EVALUATE 



TO MSGIO (1 : 5) 



TO MSGIO (1 : 5) 



TO MSGIO (1:5) 



00083400 
00083400 
00083400 
00083400 
00083400 
00083400 
00083400 
00083400 
00083400 
00083400 
00083400 
00083400 



R2 85 -END-OF- SEARCH-EXIT . 
EXIT. 

R300-READNEXT- INDICES . 
****************************************************************** 

***** READS NEXT BENEFIT INDEX ******* 
****************************************************************** 

EXEC CICS 

READNEXT 

FILE ( ' DEFMFB1 ' ) 

INTO (WS-MFB1 -RECORD ) 

RIDFLD (WS-MFB1 -KEY) 

RESP (WS-RESP) 
END-EXEC 



SET WS-READNEXT TO TRUE 
PERFORM R280-CHECK-RESP THRU 
R280-CHECK-RESP-EXIT 



R300-READNEXT- INDICES-EXIT . 
EXIT. 



R350-READPREV-INDICES. 
****************************************************************** 

***** READS PREVIOUS BENEFIT INDEX ******* 
****************************************************************** 

* MOVE ' B350 ' TO WORK- PARA 



EXEC CICS 

READPREV 

FILE ( 1 DEFMFB1 ' ) 

INTO (WS-MFB1-RECORD) 

RIDFLD (WS-MFB1-KEY) 

RESP (WS-RESP) 
END-EXEC. 



SET WS-READPREV TO TRUE 0 
PERFORM R2 80 -CHECK-RES P THRU 
R2 80 -CHECK-RES P- EXIT 

R350-READPREV-INDICES-EXIT . 
EXIT. 



S300-SYSLOG . 



************************************************************** 
***** ****** 
***** THIS ROUTINE WILL BUILD A MESSAGE TO BE PLACED ****** 
***** 0N THE SYSTEM LOG, AND IT WILL LINK TO THE ****** 
***** AFC SYSTEM LOGGER PROGRAM. ****** 
***** ****** 
************************************************************** 



MOVE ' S300' 



TO 



WORK- PARA. 



MOVE 0 



TO 



DTC-PROCESS-DIR. 



PERFORM X4 00 -GET -DATE-TIME 

THRU X4 00 -GET -DATE-TIME-EXIT . 



MOVE 


DTC-GMT 


TO 


SLF-TRANS-DT-TM. 


MOVE 


EIBTRMID 


TO 


SLF-TERMINAL-ID . 


MOVE 


WS-PROGRAM-ID 


TO 


SLF-PROGRAM-ID. 


MOVE 


STC-USER-ID 


TO 


SLF-INITIATOR-ID. 


MOVE 


EIBTASKN 


TO 


SLF- INITIATOR-TASK- ID 








SLF-PROCESSOR-TASK . 


EXEC 


CICS LINK 








PROGRAM 


( 'CWAC3100' ) 






COMMAREA 


(SYSTEM-LOGGER- 


■COMMAREA) 



LENGTH (LENGTH OF S YS TEM- LOGGER-COMMAREA ) 
RESP (WS-RESP) 

END-EXEC. 



S300-SYSLOG-EXIT. 
EXIT. 

/ 



W2 00 -WRITE-BEFORE- IMAGE . 



SET SLC-MESSAGE-IN-COMMAREA 



TO 



SET SLF- UPDATE- RECORD- BE FORE 

TO 

********** MOVE LENGTH OF EF3- CARDHOLDER 
********** MOVE EF3 -CARDHOLDER TO 

PERFORM S300-SYSLOG 

THRU S300-SYSLOG-EXIT. 

IF WS-RESP NOT = DFHRESP ( NORMAL ) 
MOVE WS-B183-NUM 
MOVE WS-B183-MSG 
MOVE WS-PFKEY-MSG1 



TRUE. 
TRUE. 

SLC-MES SAGE-LENGTH . 
SLF-MESS AGE- VALUE . 



TO MSGNUMO 

TO MSGIO 

TO PFKEY-MSGO 



00103000 
00103000 
00089200 



END-IF. 

W2 00 -WRITE- BEFORE- IMAGE-EX IT . 
EXIT. 



/ 

X100-WRITE-QUEUE. 
+**********************^ 

* THIS PARAGRAPH WRITES DATA TO THE TEMPORARY STORAGE QUEUE. 
MOVE *X100' TO WORK- PARA. 

COMPUTE SQA-QUE-NUM = STC-MAX-Q- ON -ENTRY ( STC-PGM-TR-CNT ) 

MOVE EIBTRMID TO SQA-TERMINAL-ID . 

MOVE LENGTH OF WS -QUEUE- DATA TO WS-RECORD-LENGTH . 

EXEC CICS WRITEQ TS 

QUEUE (SQA-QUE) 

FROM (WS-QUEUE-DATA) 

LENGTH (WS-RECORD-LENGTH) 

ITEM (WS-ITEM) 

REWRITE 

RESP (WS-RESP) 

END-EXEC. 

IF WS-RESP = DFHRESP (QIDERR) 

MOVE +1 TO WS-ITEM 

EXEC CICS WRITEQ TS 

QUEUE (SQA-QUE) 

FROM ( WS -QUEUE- DATA ) 

LENGTH (WS-RECORD-LENGTH) 

ITEM (WS-ITEM) 

RESP (WS-RESP) 

END-EXEC 
END-IF . 

IF WS-RESP NOT = DFHRESP (NORMAL) 



00272600 
00272700 
r 00272800 
r 00272900 
r 00273000 
00273100 
00273200 
00273400 
100273500 
00273600 
00273700 
00273800 
00273900 
00274000 
00274100 
00274200 
00274300 
00274400 
00274500 
00274600 
00274700 
00274800 
00274900 
00275000 
00275100 
00275200 
00275300 
00275400 
00275500 
00275600 
00275700 
00275800 
00275900 
00276000 



GO TO SKABEXIT-LEVEL2 
END-IF . 

X100-WRITE-QUEUE-EXIT . 
EXIT. 

X200-READ-QUEUE . 

* THIS PARAGRAPH READS DATA FROM THE TEMPORARY STORAGE QUEUE. * 

MOVE 'X200' TO WORK- PARA. 

COMPUTE SQA-QUE-NUM = STC-MAX-Q-ON- ENTRY ( STC-PGM-TR-CNT ) + 

MOVE EIBTRMID TO SQA- TERMINAL- I D . 

MOVE LENGTH OF WS -QUEUE- DATA TO WS-RECORD-LENGTH . 

EXEC CICS READQ TS 

QUEUE (SQA-QUE) 

INTO (WS -QUEUE- DATA) 

LENGTH (WS-RECORD-LENGTH) 

ITEM (WS-ITEM) 

RESP (WS-RESP) 

END-EXEC. 

IF WS-RESP NOT = DFHRESP (NORMAL) 

GO TO SKABEXIT-LEVEL2 
END-IF. 

X200-READ-QUEUE-EXIT . 
EXIT. 

/ 

X300-READ-REFER. 

* THIS PARAGRAPH READS DATA FROM THE REFERENCE TABLE. * 



MOVE 'X300' TO WORK- PARA. 

MOVE REFERENCE- FILE- VALUES 
MOVE WS-BIN-2C 
MOVE WS-TINY-CHR 

MOVE LENGTH OF RF-REFERENCE-RCD 



TO RF-TABLE-ID. 

TO WS-TINY-INT. 

TO RF-TABLE-ENTRY-ID . 

TO WS-RECORD-LENGTH. 



EXEC CICS READ 
FILE 



INTO 
LENGTH 
RIDFLD 
GENERIC 
EQUAL 

KEYLENGTH (5) 

RESP (WS-RESP) 



( ' DEFMF03 ' ) 
(RF-REFERENCE-RCD) 
(WS-RECORD-LENGTH) 
(RF-KEY) 



END-EXEC. 
IF WS-RESP 



DFHRESP (NORMAL) 



00276100 
00276200 
00276300 
00276400 
00276500 
00276600 
00276700 
00276800 
00276900 
00277000 
00277100 
00277200 
00277400 
100277500 
00277600 
00277700 
00277800 
00277900 
00278000 
00278100 
00278200 
00278300 
00278400 
00278500 
00278600 
00278700 
00278800 
00278900 
00279000 
00279100 
00279200 
00279300 
00279400 
00279500 
00279600 
00279700 
00279800 
00279900 
00280000 
00280200 
00280300 
00280400 
00280500 
00280600 
00280700 
00280800 
00280900 
00281000 
00281100 
00281200 
00281300 
00281400 
00281500 
00281600 
00281700 
00281800 
00281900 



AND RF-ENTRY-ACTIVE 

MOVE RF-ENTRY- DESCRIPTION (1:15) TO WS-DESC 

ELSE 

MOVE ? DESC NOT FOUND' TO WS-DESC 

END-IF. 

X300-READ-REFER-EXIT . 
EXIT. 



00282000 
00282100 
00282200 
00282300 
00282400 
00282500 
00282600 
00282700 



X4 00-GET-DATE-TIME. 
***************************************** 

***** * * * * 

***** ROUTINE TO LINK TO GMT CONVERSION PROGRAM TO GET **** 

***** DATE AND TIME **** 

***** **** 
************************************************************ 



MOVE 'XSOO' 
MOVE 0 



TO WORK- PARA. 
TO DTC-RTN-CODE. 



EXEC CICS LINK 

PROGRAM ('CWAX3000') 

COMMAREA ( DATE-TIME-CONVERSION) 

LENGTH (LENGTH OF DATE-TIME-CONVERSION) 



RESP 



END-EXEC. 



(WS-RESP) 



IF WS-RESP NOT = DFHRESP { NORMAL) 
MOVE WS-B18 6-NUM 

MOVE WS-B18 6-MSG 
MOVE WS-RESP 
MOVE WS-RESP-9-DISPLAY 
MOVE WS-PFKEY-MSG1 



TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 

TO WS-RESP-9-DISPLAY 
TO MSGIO (28 : 2) 
TO PFKEY-MSGO 



00063300 



00089200 



SET STC- EDIT -ERROR 



TO 



TRUE 



ELSE 

IF DTC-RTN-CODE > 5 
MOVE WS-B185-NUM 

MOVE WS-B185-MSG 
MOVE WS-PFKEY-MSG1 



TO MSGNUMO 

STC-HELP-MSG 
TO MSGIO 
TO PFKEY-MSGO 



00063300 
00089200 



SET STC-EDIT -ERROR 
END-IF 
END-IF 



TO 



TRUE 



X4 00 -GET-DATE -TIME -EX IT . 
EXIT. 



/ 

-INC CWPL9020 
/ 

-INC CWPL9030 
/ 

-INC CWXL9910 
/ 



00284200 
0028430% 
00284400 
0028450% 
00284600 
0028470% 
00284800 



INC CWXL9990 



0028490% 



APPENDIX I 



Copyright 1988 Cubic Western Data 
San Diego, California 



File: SMADDEB . H 

Description: Common literal definitions and prototypes 



#ifndef SMADDEB_HDR 
#define SMADDEB_HDR 

#ifndef SHMSG005 
#include "shmsgOOS.h" 
#endif 



#ifndef SHDSMPUB_H 
#include "shdsmpub.h" 
ttendif 

#ifndef SMADFEP_HDR 
#include "smadf ep . h" 
#endif 

/* Name of queue.*/ 
#define DEB_QUEUE_NAME "WqueuesWDeb. que" 



typedef struct 
{ 

UCHAR uchRef No [RETRIEVAL_REFJQUMBER_MAX] ; 
} DC_SECURE_DEL_REQUEST; 



/* Message from SMADFEP thread to response from device for SECURE or DELETE DC 
TRANS msgs */ 
typedef struct 
{ 

UCHAR uchMachine; 

UCHAR uchRef No [RETRIEVAL_REF_NUMBER_MAX] ; 
UCHAR uchResultCode; 
} DC SECURE DEL RESPONSE; 



/* EUCx msg block from device via FEP thread to DBCD Thread */ 
typedef struct 



{ 

UCHAR uchMachine; 
TX_MULTI_BLOCK_MSG EUC_Msg; 
} DC TRANS RESPONSE; 



/* Mail msg block from SHDEBCRED module via SendToDevice function */ 

/* When the SHDEBCRD module receivs a MACK fromthe CC after a transaction 

has been sent and received, the Mack is passed to the 

SendToHost function which send sthe DC_DEL_TRANS to the DCThread. 

The DCThread will send the message via the FEP Thread to delete the 

specified Debit/Credit transaction. */ 
typedef struct 
{ 

UCHAR uchMachine; 

UCHAR uchMackType [MSG_ID__TYPE__MAX] ; /* 4 byte msg type (EUC3/4/5 */ 
ULONG ulCICS; /* CICS Number used in header of CC message */ 
UCHAR auchRef Num [RETRIEVAL_REF_NUMBER_MAX] ; /* reference number */ 
} DC DEL TRANS; 



/* External EUC2 or MACK message received from SHDEBCRE thread * / 

typedef struct 

{ 

M S G_C_H E ADE R t H DR ; 

UCHAR uchData [MSG_MAX_LENGTH - sizeof (MSG_C_HEADER) ] ; 

} DC EXTERNAL EUC2 MSG; 



/* Mail que message used to send message from SendToDevice to DC_THREAD */ 

typedef struct 

{ 

UCHAR uchMachine; 
USHORT usSize; 
MSG_C_HEADER tHDR; 

UCHAR uchData [MSG_MAX_LENGTH - si zeof (MSG_C_HEADER) ] ; 

} DC EXTERNAL EUC MSG; 



#endif 



APPENDIX J 



/* 



Copyright 1995 Cubic Western Data 
San Diego, California 



File: SMADDEB.C 
Description : 



Date; 
By: 



22 June 1997 
DPY 



INCLUDE 



FILES 



#define INCL_BASE 

#include <stdio.h> 

#include <stdlib.h> 

#include <io.h> 

#include <os2.h> 

#include <string . h> 

#include <stddef . h> 

#include <process.h> 



#include 
#include 
#include 
#include 
#include 
#include 
tinclude 
#include 
#include 
#include 
tinclude 
#include 
#include 
#include 
#include 
#include 



"smadcmn . h" 
"smaderr . h" 
"smadmsg . h" 
"smadmsq . h" 
" smadadm. h" 
"smadf ep . h" 
"shlibOOO.h" 
"shmsg004 .h" 
"shmsgOOS .h" 
"shmsg006.h" 
"shapcOOO.h" 
"smadprot . h" 
"shdsmpub.h" 
"shdebcre . h" 
"smadccx . h" 
"smaddeb . h" 



/* LITERAL DECLARATIONS */ 

#define DC_EUC2_MAX_SIZE 512 

#define DC_TRANS_MAX_SIZE 512 /* for temp storage of EUC3, EUC4 , or EUC5 
V 



/* Return codes and defines used only in this module */ 



tdefine DC_EUC2_MAX_WAIT 

#define DC_MAX_WAIT 

tdefine DC_EBCDIC_ZERO 
ZERO */ 

#define DC_EBCDIC_B 
V 



12000 /* 12 seconds */ 

10000 /* 10 seconds */ 

240 /* HEX F0 value for EBCDIC character 

0xC2 /* HEX C2 value for EBCDIC character *B' 



#define DC_EUC2_TIMEOUT 99 /* local msg codes for this module */ 

#define DC_SECURE_TIMEOUT 98 

#define DC_DELETE_TIMEOUT 97 

#define DC_EUC2_NAK 96 

#define DC_SECURE_NAK 95 

#define DC_DELETE_NAK 94 

#define DC_RESEND_TIMEOUT 93 

#define DC TRANS TIMEOUT 92 



#define SIX_HOURS 21600 /* 60*60*6 */ 

#define DC_STACKSIZE 100000 

#define DC_DEL_MAX_RETRY 1 
#define DC_EUC2_MAX_RETRY 1 

#define DC_MAX_RETRY 2 /* max times to resend after timeouts waiting for 

response */ 

#define DC_MAX_RE SEN D_RET RY 10 /* try more for resend commands */ 
/* offsets into EUC external packed byte messages */ 

#define DC_EUCl_RET_REF_OFFSET 174 /* offset from start of EUC1/EUC6 to ret.ref 
field V 

#define DC_EUC3_RET_REF_OFFSET 17 8 /* offset from start of EUC3 to ret.ref 
field */ 

#define DC_EUC5_RET_REF_OFFSET 351 /* offset from start of EUC5 to ret.ref 

field */ 

#define DC_EUB1_RET_REF_0FFSET 39 
#define DC_EUB5_RET_REF_OFFSET 39 
#define DC EUB3 RET REF OFFSET 39 



/* States for device */ 
#define DC_IDLE 1 
# define DC_TRANS_ACK 2 
#define DC_WAITING_ACK 3 

/* some constants for setting up transaction index */ 
tdefine DC_SERIAL_NUMBER_DIGITS 5 

tdefine DC_SERIAL_NUMBER_SHIFT 10000000 /* low order 7 digits is GMT, high 
digits for serial num */ 

#define DC_MSG_TYPE_SHIFT 10 /* decimal shift for EUC msg type (1 digit) 

V 

#define DC_GMT_DIGITS JEN_JLONG 10 /* number of decimal digits in a LONG viewed 
in ASCII format */ 

#define DC__GMT_DIGITS 7 

/* Used in DBCRDT_Error */ 

tdefine DC ERROR MESSAGE "DC Error: 



ttdefine DC_ERR_LINENO 10 

#define DC_ERR_MSG_SZ sizeof (DC_ERROR_MESSAGE) 

/* Typedefs */ 
typedef enum DC_EVENTS 
{ DC_EUC2_EVENT=0, 

DC_SECURE_EVENT, 

DC_DELETE_EVENT, 

DC_RESEND__EVENT , 

DC_MAX_EVENT 
} DC TIMEOUT EVENTS; 



typedef struct 
{ 

UCHAR 

UCHAR 

□SHORT 

□SHORT 

□SHORT 

□SHORT 

□SHORT 

□SHORT 

□SHORT 

INT 

INT 

resend msg */ 

UCHAR 

UCHAR 

UCHAR 
external format*/ 

UCHAR 

UCHAR 

ULONG 

ULONG 

ULONG 

TIME_T 
} DC DEVICE STR; 



uchBlock; 
uchC2Block; 
usBytePtr ; 

usState [DC_MAX_EVENT] ; 

usRetryCount [ DC_MAX_EVENT ] ; 

usSeqNum; 

usC2SeqNum; 

us Trans Index ; 

usTryAgain; 

iMsgSize ; 

iOrgSize; /* Save original size in case we have to 
uchMackType [MSG_ID_TYPE_MAX] ; 

EUC2 [DC_EUC2__MAX_SIZE] ; /*EUC2 in external format* 
uchExt_TRANS [DC_TRANS_MAX_SIZE] ; /* EUC3 , 4 or 5 

uchSecureRefNo [RETRIEVAL_REF_NUMBER_MAX] ; 

uchDeleteRef No [ RE T R I E VAL_RE F_NUMB E R__MAX ] ; 

ulErrorCount ; 

ulCICS; 

uiEUC2_CICS; 

ulTime[DC MAX EVENT] ; 



/* EXTERNAL DECLARATIONS */ 

extern PPVOID SMADS sel; 



/* GLOBAL DECLARATIONS */ 
UCHAR auchTmpMsg[80] ; /* for debug string output */ 
HQUEUE ulDEB_CRED__handle; 
ULONG ulDC_Debug = FALSE; 

ULONG ulEVDC_Debug = FALSE; /* Used for table handline */ 
static DC DEVICE STR tDevice Str[MAX NUM VENDORS]; 



/* prototype */ 

VOID ENV_CDECL DCThread (PVOID dummy) ; 

/*VOID ENV_CDECL Format EUC_Msg (PVOID , USHORT );*/ 



* Module: DBCRDT_Di splay 

* Desc: This displays messages sent to the CC for Debit/Credit Transactions 
* 

* Inputs: Pointer to string to Display 

* Outputs: N/A 

* Errors: Default Error Processing. 



VOID DBCRDT_Display (PCHAR szDispStr) 
{ 



PCHAR pStr; 



/* strip of the \r\n characters from the string passed in */ 
pStr = (PCHAR) raemchr (szDispStr, '\r', 80); 
if (pStr != NULL) 
{ 

*pStr = ' \0' ; 

} 



SH_REPORT_EVENT ( NOT I FY_EVENT , 

MC_STATUS_NONE, MC_STATUS_IGNORE, 
(APIRET) 0, 
szDispStr) ; 



* Module: DBCRDR_DSM_Created 

* Desc: This function will not do anything for transit authority 

* Inputs: N/A 

* Outputs: N/A 

* Errors: Default Error Processing. 



VOID DBCRDT_DSM_Created (VOID) 
{ 



APIRET error ind; 



/* send message to DCThread*/ 

error_ind = WriteToQ ( &ulDEB_CRED_handle, SMADS_sel, DC, 

NULL, DC_MSG, DC_RESEND, 

0, 0); 
if (error_ind != 0) 
{ 

S H_RE PORT_EVENT ( WARN I NG_E VENT , S H_S TATU S_S WERR , 

SH_STATUS_IGNORE, error_ind, 



} 

} 



"Error Returned by WriteToQ" ); 



/****************************************************************************** 

* Module: DBCRDT_Error 

* Desc: This perform any error handling for Debit/Credit 
* 

* Inputs: Error Information and the File and line that it occured 

* Outputs: N/A 

* Errors: Default Error Processing. 

******************************** J 

VOID DBCRDT_Error ( INT iErrorlD, ULONG ulErrorCode, 

PCHAR szFileName, SHORT sLineNo) 

{ 

static CHAR szMsg[120]; 



sprintf (&szMsg[0], "%s%3i Code:%09x, Line:%4i, File:%s", 

"DC_ERROR: iErrorlD, ulErrorCode, sLineNo, szFileName) ; 

SH_REPORT_EVENT ( WARNING_EVENT , SH_STATUS_SWERR, 
SH_STATUS_IGNORE, (ULONG) iErrorlD, 
szMsg) ; 

} 

/****************************************************************************** 

* Module: CredDeblnit 

* Desc: This performs all initialization to the debit/credit thread 
* 

* Inputs: N/A 

* Outputs: N/A 

* Errors: Default Error Processing. 

*****************************************************************************^.y 

APIRET DebCredlnit (VOID) 
{ 



BOOL 
USHORT 
USHORT 
ULONG 
INT 
resent */ 
INT 

wait 

SMADDEB 

delivered 



rc; 

Debit_Version; 
Debit_Revision; 
ulStatus ; 

iSecondsForResend = 180; /* 3 minutes check for messages to be 
iHalfSecWaitsForMack; /* Used to init SHDEBCRE for how long to 

for an EUC2 MACK from device (or this 
thread in the case an EUC2 could not be 
to the device . */ 



/* Note: must be slightly longer 

then 2* ( ( DC_EUC2_MAX_RETRY+1 ) *DC_EUC2_MAX_WAIT/ 1000 ) */ 
iHalfSecWaitsForMack = 8 + (2 * ( ( DC_EUC2_MAX__RETRY+1 ) * 
(DC_EUC2_MAX_WAIT/1000) ) ) ; 

/* calculates to 56 (28 seconds) : 

2 retries after 12 second response waiting periods (16 seconds) plus 4 
seconds extra*/ 

/* create the queue for receiving messages from other threads */ 
do 



{ 



} 



ulStatus = DosCreateQueue ( &ulDEB__CRED__handle , 0, DEB_QUEUE_NAME) ; 
DosSleep (500L) ; 



while (ulStatus != 0) ; 



/** Debit/Credit device Thread **/ 

if (_beginthread (DCThread, NULL, DC_STACKSIZE, NULL) 



= 1) 



{ 



WriteString ( "DC thread creation error " , 20 , 3 ) ; 



/** Initialize Debit/Credit Threads ***/ 
Debit_Version = 1; 
Debit_Revision = 0; 

rc = DBCRDT_Init ( Debit_Version, Debit_Revision, 
iHalfSecWaitsForMack, 
iSecondsForResend) ; 



return ( (API RET ) rc) ; 



* Module: DC_Create_DSM_Index 

Create lookup index and info field used by the DSM in the SHDBCRD 



* Desc: 
thread 

(DSM) . 
6) 

field 
number, 

the 3 
by 



for unique key for the transaction in the data storage manager 

The DSM uses the MSG_C_HEADER CICS (4 byte integer) field. To make 
this unique, we will use the vendor number and transaction type (1- 

and the 7 digits of the 

GMT from the EUCx message RETRIEVAL_REF_N UMBER field. (Note this 
is 12 EBCDIC digits - 5 high order digits are the device serial 
the lower 7 digits are the GMT) . 

The 5 serial number digits in the RETRIEVAL_REF_NUMBER are put into 
byte auchlnfo field that is kept with the transaction and returned 



the DSM in MACK messages. 
The CICS key is: 

v, vcg, ggg, ggg 
where 'vv' is the vendor number (0-15) 

'c' is in the range 1 to 6 (the x from EUCx message 



type) 
* 

RETRIEVAL REF NUMBER 



' ggggggg ' is the 7 GMT digits from the 



* Inputs: pauchRefNum 

* uchMachine 

* uchMsgType 

* Outputs: pauchlnfo 
(binary) 

* pulCICS 



message type) 



Pointer to EBCDIC string for RETRI EVAL_RE F_N UMBER 
machine number; 

message type (1 to 6 for EUC1 to EUC6 ) 

Pointer to 3 byte string for machine serial number 

Pointer to long for unique key 
The CICS key is: 

v, vcg, ggg, ggg 
where 'vv' is the vendor number (0-15) 

' c ! is in the range 1 to 6 (the x from EUCx 



* 'ggggggg' is the 7 GMT digits from the 
RE T R I E V AL_RE F__N UMB E R 

* Errors: Default Error Processing. 
************************************ 

VOID DC_Create_DSM_Index (PUCHAR pauchRefNum, UCHAR uchMsgType, 

UCHAR uchMachine, PUCHAR pauchlnfo, PULONG 

pulCICS) 
{ 



UCHAR uchGMT[DC_GMT_DIGITS+l] ; 

UCHAR uchSerialNum [DC_SERIAL_NUMBER_DIGITS+1 ] ; 
ULONG ulTemp; 



/* extract GMT from retrieval reference number */ 

LIB__cnv_ebcdic_to_ascii ( ( PUCHAR) pauchRef Num+DC_SERIALJSfUMBER_DIGITS , 

(PUCHAR) &uchGMT, DC_GMT_DIGITS ) ; 

/* extract Serial Number retrieval reference number */ 
LIB_cnv_ebcdic_to_ascii ( (PUCHAR) (pauchRefNum) , 

( PUCHAR) SuchSerialNum, DC_S ERI AL_NUMBER_DI G I TS ) ; 

/* null terminate the strings for calls to atol */ 
uchGMT[DC_GMT_DIGITS]= 1 \ 0 1 ; 

uchSerialNum [ DC_SERIAL_NUMBER_DIGITS] = ' \0 1 ; 

/* convert GMT to integer and add to machine numbere shifted left by 7 
digits */ 

ulTemp = uchMachine - START__VENDOR_ADDRESS; 

^pulCICS = ulTemp * DC_SERIAL_NUMBER__SHI FT * DC_MSG_TYPE_SHIFT ; 
ulTemp = uchMsgType * DC_SERIAL_NUMBER_SHIFT; 



*pulCICS +=* ulTemp; /* add in msg type digit */ 

ulTemp = atol ( ( PCHAR) &uchGMT [0] ) ; 

*pulCICS += ulTemp; /* add in 7 digits of GMT */ 

/* save 3 bytes of serial number into Info array. Note no loss of data since 

the serial number is only 5 digits of value (max 99999) */ 
ulTemp - atol {(PCHAR) &uchSerialNum [ 0 ] ) ; 
memcpy (pauchlnfo, &ulTemp, DSM_INFO_SIZE) ; 

return; 



* Module: DC_Create_Ref Num 

* Desc: Create RE T R I E VAL_RE F_N UMBER from lookup index and info field used by 
the DSM in 

* the SHDBCRD thread. 

* Use lower 7 digits from the CICS field (GMT) and 5 digit seerial 
number from the 

* Info field. 



* Inputs : pauchlnfo 
(binary) 

* ulCICS 



message type) 

RETRI EVAL_RE F_N UMBER 

* Outputs: pauchRef Num 

* puchMachine 



Pointer to 3 byte string for machine serial number 

Pointer to long for unique key 
The CICS key is: 

v, vcg,ggg, ggg 
where 'vv' is the vendor number (0-15) 

! c* is in the range 1 to 6 (the x from EUCx 

'ggggggg' is the 7 GMT digits from the 

Pointer to EBCDIC string for RETRIEVAL_REF_NUMBER 
Pointer to machine number; 



* Errors: Default Error Processing. 



VOID DC_Create_RefNum (PUCHAR pauchlnfo, ULONG ulCICS, PUCHAR pauchRef Num, 

PUCHAR puchMachine) 

{ 



ULONG ulSerialNum; 

ULONG ulGMT; 

ULONG ulMachine; 

ULONG ulMsgType; 
PUCHAR ptr; 

UCHAR achTempChar [DC_GMT_DIGITS_IN_LONG] ; 
ptr = (PUCHAR) &ulMachine; 



ulMachine = (ulCICS / DC_SERIAL_NUMBER_SHI FT ) / DC _MSG_TYPE_SHI FT; 
ulMsgType = (ulCICS / DC_SERIAL_NUMBER_SHI FT ) - (ulMachine * 
DC_MSG_TYPE_SHIFT) ; 

ulGMT = ulCICS - (ulMachine * DC_SERIAL_NUMBER_SHIFT * DC_MSG_TYPE__SHIFT) 
(ulMsgType * DC_SERIAL NUMBER SHIFT); 



ulSerialNum = 0; 

memcpy ( (CHAR* ) &ulSerialNum, pauchlnfo, DSM_INFO_SIZE) ; 



/* move machine number into return parameter */ 
*puchMachine = *ptr + START_VENDOR_ADDRESS ; 

/* build Retrieval Reference Number */ 

sprintf ( ( PCHAR) &achTempChar [ 0 ] , "%*i", DC_SERIAL_NUMBER_DIGITS , 
ulSerialNum) ; 

memcpy (pauchRef Num, &achTempChar , DC_SERIAL_NUMBER__DIGITS ) ; 

/* overlay msg type onto 1st byte since EUC4 and EUC5 Retrieval Reference 
Numbers 

are the same */ 

no ^ this is not implemented in EV ! ! 
sprintf ( (PCHAR) &achTempChar [ 0] , 1, ulMsgType) ; 

*pauchRefNum = *achTempChar ; 

************************** I 



sprintf ( (PCHAR) &achTempChar [ 0 ] , "%0*li", DC_GMT_DIGITS , ulGMT) ; 
ptr = ( (UCHAR *) pauchRef Num) + DC_SERIAL_NUMBER__DIGITS ; 
memcpy (ptr, &achTempChar [0] , DC_GMT_DIGITS ) ; 

/* convert retrieval reference number to EBCDIC */ 
LIB_cnv_ascii_to_ebcdic (pauchRef Num, pauchRefNum, 
RETRIEVAL REF NUMBER MAX); 



return ; 

} 

/***************************************+****^ 

* Module: DBCRDT_SendToDevice 

* Desc: 

* Inputs: Pointer to message, 

* Message Length, 

* Pointer to Info used to ID the message or device (generated in call 
to 

* DBCRDT_SendToHost . 

* Outputs: successful/unsuccessful 

* Errors: Default Error Processing. 

****************************************************************************** ^ 

BOOL DBCRDT_SendToDevice (PUCHAR pszMsg, USHORT usMsgLength, PUCHAR pauchlnfo) 
{ 



APIRET error_ind; 

INT iVer; 

INT iEUC2; 

INT iBusy; 

UCHAR szMsgType [ M S G_ I D_T Y P E_MAX ] ; 



UCHAR uchSt r Index; 



DC_EXTERNAL_EUC_MSG tEUC; /* Mail message to be sent to DC Thread for 

EUC2*/ 

DC_DEL_TRANS t DEL ; /* Mail message to be sent to DC Thread for 

MACK */ 

MSG_C_MACK *ptMACK; 
char szFepMsg[24] ; 

iVer = TRUE; /^Assume no errors */ 
iEUC2 = FALSE; 
iBusy = FALSE; 

if ((pauchlnfo == (PUCHAR) NULL) || (pszMsg == (PUCHAR) NULL) ) 
{ 

iVer - FALSE; 

} 

else if {usMsgLength > sizeof ( tEUC) ) 
{ 

iVer = FALSE; 

} 

if (iVer) 
{ 

/* 

sprintf (&szFepMsg[0] , "To device: " ) ; 

Write_Log_Msg ( "dctran. hex" , szFepMsg, pszMsg, usMsgLength ); 
*/ 

/*ptEUC2 = (DC_EXTERNAL_EUC2_MSG *) pszMsg;*/ 
ptMACK = (MSG_C_MACK *) pszMsg; 

tEUC.usSize = usMsgLength; 
/* Copy the message */ 

memcpy (StEUC.tHDR, pszMsg, usMsgLength); 
/* get message code */ 

LIB__cnv_ebcdic_to_ascii ( (PUCHAR) pszMsg, (PUCHAR) &szMsgType, 

MSG_ID_TYPE_MAX) ; 
if ( !strncmp(szMsgType, MSG_ID_EUC2, MSG_ID__TYPE_MAX) ) 
{ 

/* for EUC2 the machine number is from the auchlnfo field (SCP)V 
tEUC . uchMachine = pauchlnf o [ 2 ] ; 
iEUC2 = TRUE; 

} 

else if ( ! strncmp ( szMsgType , MSG_ID_EUB2, MSG_ID_TYPE_MAX) ) 
{ 

/* for EUC2 the machine number is from the auchlnfo field (SCP)*/ 
tEUC . uchMachine = pauchlnf o [2] ; 
iEUC2 - TRUE; 

} 

else if ( !strncmp(szMsgType, MSG_ID_EUCO, MSG_ID_TYPE_MAX) ) 

{ 

error_ind = WriteToQ (&ulDEB_CRED_handle, SMADS_sel, DC, 

(PVOID) NULL, DC_MSG, DC_EUCO_RSP, 0,0); 

if (error_ind !- 0) 



{ 

SH_REPORT_EVENT ( WARNING_EVENT , SH_STATUS_SWERR, 

SH__STATUS_IGNORE , error_ind, 
"Error Returned by WriteToQ" ) ; 

} 

iVer - FALSE; 
iEUC2 = FALSE; 

} 

else 
{ 

/* If this is a MACK then the machine number is encoded in the CICS 



/* Convert message to DC_DELETE_TRANS deiete_msg */ 
tDEL.ulCICS = ptMACK->cics_trans_no. v; 
DC_Create_RefNum ( (PUCHAR) pauchlnf o, t DEL . ulCICS , 

( PUCHAR) &t DEL . auchRef Num, ( PUCHAR) StEUC . uchMachine ) 

tDEL . uchMachine = tEUC . uchMachine ; 

memcpy ( & tDEL . uchMackType [ 0 ] , (PUCHAR) (pszMsg+MSG_ID_TYPE_MAX) , 
MSG_ID_TYPE_MAX) ; 

} 

if { (tEUC. uchMachine < START_VENDOR_ADDRESS ) M 

(tEUC. uchMachine > ( START_VENDOR_ADDRESS+MAX_NUM_VENDORS ) ) ) 

{ 

if (iVer) 
{ 

/* invalid message */ 

SH_REPORT_EVENT ( WARNING_EVENT , SH__STATUS_SWERR, 

SH_STATUS_IGNORE, (ULONG) tEUC . uchMachine , 
"SendToDevice Invalid Machine Number"); 

iVer - FALSE; 

} 



f (iVer) 

/* check if machine is talking to us */ 

error_ind = STATCommlnitVer (tEUC . uchMachine, &iVer) ; 

if (iVer && 1EUC2) 

{ 

uchStrlndex = tEUC . uchMachine - START_VENDOR_ADDRESS ; 

/* check machine is in the correct state to process EUC2 */ 

if (tDevice_Str [uchStrlndex] .usState [DC_EUC2_EVENT] != DC_IDLE) 

{ 

/* Set flag so that we do not send a NAK */ 

/* If we are in the wrong state, do not send a response to CC, 
Let the CC timeout or receive the response for the EUC2 
that is already inprogress */ 

iBusy = TRUE; 

iVer - FALSE; 

} 

} 



f (iVer) 



if (iEUC2) 
{ 

/* euc2 */ 

/* send message to DCThreacl*/ 

error_ind = WriteToQ ( &ulDEB_CRED_handle , SMADS_sel, DC, 
StEUC, DC_MSG, DC_EUC2, 
usMsgLength + sizeof ( tEUC . usSize) + 
si zeof ( tEUC . uchMachine ) , 0); 

if (error ind != 0) 



{ 



S H_RE PORT_E VENT ( WARN I NG_E VENT , S H_S T ATU S_S WERR , 

SH_STATUS_IGNORE, error_ind, 
"Error Returned by WriteToQ"); 

iVer = FALSE; 



if ( ! strncmp (szMsgType, MSG__ID_MACK, MSG_ID_TYPE_MAX) ) 
{ 

/* Send message to DCThread*/ 

error_ind = WriteToQ ( &ulDEB_CRED_handle, SMADS_sel, DC, 
&tDEL, DCJVISG, DC__DELETE_TRANS, 
sizeof (tDEL) , 0) ; 

if (error_ind ! = 0) 

{ 

SH_REPORT_EVENT ( WARNING_EVENT, SH_STATUS_SWERR, 

SH_STATUS_IGNORE, error_ind, 
"Error Returned by WriteToQ"); 

} 



MACK 

DC thread, 
message 

} 

} 

else 
( 



/* Set return to false so that the DSM module will not update the 

message as completed. After the device ACKs this message in the 

then the DC thread will notify the DSM that is is OK to mark the 

as completed */ 
iVer = FALSE; 



send 
that 
device, 
CC wait 
EUC2 . */ 



/* Problem with this device, still recieving a previous EUC2)*/ 

if ( ( 1EUC2 ) && (iBusy)) 

{ 

/* If this is an EUC2 and the device is not in the correct state to 
an EUC2, then do nothing. Send TRUE back to shdebcre module so 
a NAK is not sent to the CC, but do not send anything to the 
this may be a case where a duplicate E0C2 has come down. Let the 
until tthe device responds, or let the CC timeout and reverse the 



/* Send TRUE response back so the EUC2 is not NAKed by SHDEBCRE 

module */ 

iVer = TRUE; 

} 

} 

return (iVer) ; 

} 

/* 

* Function: DC_Device 

* Desc: Checks if device is a debit/creit device. 

* Inputs: Device Id 

* Outputs : None 

* Return Value: returns TRUE id device has debiit /credit ; else returns FALSE 

* External Effects: None 
************************ 

*/ 

INT DC__Device ( UCHAR uchDevice) 
{ 

APIRET error_ind; 
int iReturn = 0; 
UCHAR status3; 

error_ind = STATGet (uchDevice, NULL, NULL, &status3, NULL, NULL, NULL) ; 

if ( status3 & VEND_EXP_VEND ) /*This is an Express Vendor*/ 
{ 

iReturn = 1; 

} 

error_ind = error_ind; 
return (iReturn); 



/****************************************************************************** 
* Module: DC_SendTranReq 

Send a TX_DC_TRANS_REQ message to a device to kick off the 
transaction request process for a new transaction. 



* Desc 

* 



Inputs: ptDevice_Str 
uchMachine 
ulCur rent Time 



Pointer to DC_DEVICE__STR for this machin e 
Machine number 
Current timestamp 



* Outputs: NONE, but ptDevice_Str is updated with new message sequence number 
and block 

* and state values. 



* Errors: Default Error Processing. 

*****************************************************************************^ 



VOID DC_SendTranReq ( DC_DEVICE_STR * ptDevice Str, 



{ 



UCHAR uchMachine, ULONG ulCur rent Time ) 



FEP_MSG_HEADER 

ULONG 

INT 



DC_Reque s t_Ms g ; 
ulStatus ; 
iVer; 



memset ( &DC_Request_Msg, 0, sizeof ( DC_Re quest __Msg ) ) ; 

DC_Request_Msg. uchBlock = 0; 

ptDevice_Str->uchBlock = 0; 

if (ptDevice_Str->usSeqNum USHRT_MAX) 

< 

ptDevice_Str->usSeqNum = 0; 

} 

else 
{ 

+ 4-ptDevice_Str->usSeqNum; 

} 

ulStatus = UtOrderTrans ( (PVOID) 6cptDevice_Str->usSeqNum, 

( PVOID) &DC_Request_Msg . usSeqNum, 
sizeof (short), sizeof (short)); 



/* request next DC transaction from the device */ 
ulStatus = STATCommlnitVer (uchMachine, &iVer) ; 
if (iVer) 
{ 

ulStatus = FEPMessage (0, (UINT) uchMachine, TX_DC_TRAN, 

sizeof ( DC_Request__Msg) , 
&DC_Request_Msg, 0) ; 

if (ulStatus != 0) 
{ 

SH_REPORT_EVENT ( WARNING_EVENT, SH__STATUS_SWERR, 
SH_STATUS_IGNORE, ulStatus, 
"Error Returned by FEPMessage"); 

} 

} 

ptDevice_Str->usRet ryCount [ DC_SECURE_EVENT] = 0; 
ptDevice_Str->usTryAgain = FALSE; 

ptDevice__Str->usState [DC_SECURE_EVENT] = DC_TRANS_ACK; 
ptDevice_Str->ulTime [DC_SECURE_EVENT] - ulCurrentTime ; 
ptDevice_Str->usTransIndex = 0; /* Start at zero offset */ 

return; 
} 

* Module: DC_CheckNAK 

* Desc: Check if the ACK message is a NAK based upon return code in ACK msg. 

* Inputs: USHORT usMsgSubcode Message code for message sent to this 
thread. 

* PUCHAR puchData Pointer to message data sent to this 
thread. 



* Outputs: Returns the message ID to process (internal msg id to this module) 

* puchMachine Machine number 

* puchStrlndex Index for this device into global 
tDevice Str 



* Errors: Default Error Processing. 



USHORT DC_CheckNAK (PUCHAR puchData, USHORT usMsgSubcode , PUCHAR 

puchStrlndex, PUCHAR puchMachine ) 

{ 

USHORT usProcMsgld; 
USHORT usSeqNum= 0; 

DC_SECURE_DEL_RESPONSE* pt DC_ACK_Msg ; 
DC_TRANS_RESPONSE* pt DC_Trans_Msg; 

ULONG ulStatus; 

usProcMsgld = usMsgSubcode; 

switch (usMsgSubcode) 

{ 

/* special handling to determine NAKs from ACKs */ 
case DC__DELETE_ACK: 

ptDC_ACK_Msg = ( DC_S ECU RE_DEL_RES PONS E *) puchData; 

^puchMachine = ptDC_ACK_Msg->uchMachine ; 

if ( (^puchMachine > MAX_VENDOR_AD DRESS ) || (^puchMachine < 
START__VEN DO R_AD DRESS ) ) 
{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE, MC_STATUS_IGNORE , 
(APIRET) ^puchMachine, 
"SMADDEB. invalid machine id in ACK message."); 
usProcMsgld = 0; 

} 

else 
{ 

•^puchStrlndex = ^puchMachine - S TART_VEN DO R_AD DRESS ; 

if (ptDC_ACK_Msg->uchResultCode == 1) 

{ 

usProcMsgld = DC_DELETE_NAK; 

} 

/* Return code 2 means nothing to delete, handle as an ACK 

to send the DSM a message to clean up. */ 
/* Else if return code is 0, check that it matches the 

DELETE 

message that was sent */ 
else if (memcmp { &tDevice_Str [*puchStrIndex] . uchDeleteRef No, 
&ptDC_ACK_Msg->uchRefNo, 
RETRIEVAL_REF_NUMBER_MAX) ! =0 ) 

{ 

/* If reference number does not match, then treat as a 

NAK */ 

usProcMsgld = DC_DELETE_NAK; 

} 



if ( (ulDC_Debug) && (usProcMsgld == DC_DELETE_NAK) ) 



{ 

sprintf (auchTmpMsg, 

"SMADDEB ... DC DELETE NAK rcvd from device %2i.", 
*puchMachine) ; 
SH_REPORT_EVENT (ETDebugOutput, 

MC_STATUS_NONE , MC_STATUS_IGNORE , 
(APIRET) 0, auchTmpMsg); 

} 

} 

break; 
case DC_SECURE: 

ptDC_ACK_Msg = ( DC_SECURE_DEL_RESPONSE *) puchData; 
*puchMachine = ptDC_ACK_Msg->uchMachine; 

if ( (*puchMachine > MAX_VENDOR_ADDRESS ) || ( *puchMachine < 
START_VENDOR_ADDRESS) ) 
{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE, MC_STATUS_IGNORE, 
(APIRET) *puchMachine, 

"SMADDEB. .. invalid machine id in ACK message."); 
usProcMsgld = 0; 

} 

else 
{ 

*puchStr Index - *puchMachine - START_VEN DO R_AD DRESS ; 

if (ptDC_ACK_Msg->uchResultCode != 0) 

{ 

usProcMsgld - DC_SECURE_NAK; 

} 

else if (memcmp ( &tDevice_Str [ *puchStrIndex] . uchSecureRef No, 
&ptDC_ACK_Msg->uchRefNo, 
RETRIEVAL_REF_NUMBER_MAX) ! =0) 

{ 

/* If reference number does not match, then treat as a 

NAK */ 

usProcMsgld = DC_SECURE_NAK; 

} 

if { (ulDC_Debug) && (usProcMsgld == DC_SECURE_NAK) ) 
{ 

sprintf (auchTmpMsg, 

"SMADDEB ... DC SECURE NAK rcvd from device %2i.", 
*puchMachine) ; 
SH_REPORT_EVENT (ETDebugOutput, 

MC__STATUS_NONE, MC_STATUS_IGNORE , 
(APIRET) 0, auchTmpMsg); 

} 

} 

break; 
case DC_EUC2_ACK: 

ptDC_Trans_Msg - ( DC_T RAN S_RE S P ON S E *) puchData; 
*puchMachine = ptDC_Trans_Msg->uchMachine; 

if ( (*puchMachine > MAX_VEN DOR_AD DRESS ) || { *puchMachine < 
START_VENDOR__ADDRESS) ) 
{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE, MC STATUS IGNORE, 



(API RET ) *puchMachine , 

"SMADDEB. . .invalid machine id in ACK message."); 
usProcMsgld = 0; 

} 

else 
{ 



*puchStr Index = *puchMachine - START_VEN DO R_AD DRESS ; 
ulStatus = UtOrderTrans ( (PVOID) &ptDC_Trans_Msg- 
>EUC_Msg . tHDR. usSeqNum, 

(PVOID) &usSeqNum, 

sizeof (short), sizeof (short)); 
/* Check result code in first byte of data protion of 

message */ 

if (ptDC_Trans_Msg->EUC_Msg. auchData [0] != 0) 
{ 

usProcMsgld = DC_EUC2_NAK; 
sprint f (auchTmpMsg, 

"SMADDEB. . .DC EUC2 NAK received from device 

%2i. 

*puchMachine) ; 
SH_REPORT_EVENT (ETDebugOutput, 

MC_STATUS_NONE, MC_STATUS_IGNORE, 
(APIRET) 0, auchTmpMsg); 

} 

else if ( (ptDC_Trans_Msg->EUC_Msg. tHDR. uchBlock == 

(tDevice_Str [ *puchStrIndex] . uchC2Block-l ) ) 
&& 

(usSeqNum == tDevice_Str [ *puchStrIndex] . usC2SeqNum) ) 

{ 

/* This is a duplicate of the last response 

received, just ignore it */ 

usProcMsgld = 0; 
sprintf (auchTmpMsg, 

"SMADDEB. .EUC2 ACK duplicate block ignored 
mach : %2i ; block : %2i ; expected : %2i " , 

*puchMachine, ptDC_Trans_Msg- 

>EUC_Msg. tHDR. uchBlock, 

tDevice_Str [*puchStrIndex] .uchC2Block) ; 
SH_REPORT_EVENT (ETDebugOutput, 

MC_S T AT US_N0NE , MC_S TATU S_I GNORE , 
(APIRET) 0, auchTmpMsg); 

} 

else if (ptDCJTrans_Msg->EUC_Msg. tHDR. uchBlock != 

tDevice_Str [ *puchStrIndex] . uchC2Block) 

{ 

/* If block/sequence number does not match, then treat 

as a NAK */ 

usProcMsgld = DC_EUC2_NAK; 
sprintf ( auchTmpMsg, 

"SMADDEB. .EUC2 ACK block mismatch; 
mach : %2i; block: %2i; expected: %2i", 

*puchMachine, pt DC_Trans_Msg- 

>EUC_Msg . tHDR. uchBlock, 

tDevice_Str [ *puchStrIndex] .uchC2Block) ; 
SH_REPORT_EVENT (ETDebugOutput, 



MC_STATUS_NONE, MC_STATUS_IGNORE , 
(APIRET) 0, auchTmpMsg); 

} 

else if (usSeqNum != tDevice_Str [ *puchStrIndex] . usC2SeqNum) 
{ 

/* If block/sequence number does not match, then treat 



as a NAK */ 



usProcMsgld = DC_EUC2 JSfAK; 
sprintf (auchTmpMsg, 

"SMADDEB. . EUC2 ACK seq num mismatch; mach:%2i; 

num:%2i; expected : %2i" , 

*puchMachine , usSeqNum, 
tDevice_Str [ *puchStrIndex] . usC2SeqNurn) ; 

SH_REPORT_EVENT (ETDebugOutput , 

MC_STATUS_NONE, MC_STATUS_IGNORE , 
(APIRET) 0, auchTmpMsg) ; 

} 

} 

break; 
default : 

ulStatus = ulStatus; /*get rid of compiler msg */ 
break; 



return usProcMsgld; 



} 



* Module: DC_CheckTimeouts 

* Desc: Check if any device has timed out waiting for a response to a 

* last message sent out. This function will retrun after it finds 

* the next device that is waiting. 



* Inputs: 
waiting . 

EUC2) 
* 

* Outputs; 
it- 
found 



uchMachine Index 

uchEvent Index 

ulCur rent Time 

Returns TRUE/ FALSE 
usProcMsgld 

ulWaitTime 

uchStrlndex 

uchMachine 



Start index to begin search for device 
Type of event watingin on (SECURE, DELETE, 
Time 

TRUE if no device found 

Message code local to this module if device 

Set time to wait on next UTREADQ call 
Index into tDevice_Str for machine waiting 
machine number in wait state 



* Errors: Default Error Processing. 

USHORT DC_CheckTimeouts (UCHAR uchMachinelndex, UCHAR uchEvent Index, 

PUSHORT pusProcMsgld, ULONG ulCurrentTime , 
PULONG pulWaitTime, 

PUCHAR puchStrlndex, PUCHAR puchMachine) 

{ 

ULONG ulTempTime; 



USHORT usCheck_for_timeouts = TRUE; 
ULONG ulWaitTime; 



if (uchEvent Index == DC_EUC2_EVENT ) 
{ 

ulWaitTime = DC_EUC2_MAX_WAIT/1000 ; 

} 

else 
{ 

ulWaitTime = DC_MAX_WAIT/1000 ; 

} 

if (tDevice_Str [uchMachinelndex] . ulTime [ uchEventlndex] != ULONG_MAX) 
{ 

if (tDevice_Str [uchMachinelndex] . ulTime [uchEventlndex] + ulWaitTime <= 
ulCur rent Time) 
{ 

/* found a device that timed out */ 

usCheck_f or__timeouts = FALSE; /* exit loop checking for device 

timeouts* / 

*puchMachine = uchMachinelndex + START_VENDOR__ADDRESS; 
*puchStrIndex = uchMachinelndex; 

if ( tDevice_Str [ *puchStr Index] . usState [uchEvent Index] == 
DC_WAITING_ACK) 
{ 

if (uchEventlndex == DC_DELETE_EVENT) 
{ 

*pusProcMsgId = DC_DELETE__TIMEOUT; 

} 

else if (uchEventlndex == DC_SECURE_EVENT ) 
{ 

*pusProcMsgId = DC_SECURE_TIMEOUT; 

} 

else if (uchEventlndex == DC_RESEND_EVENT ) 
{ 

*pusProcMsgId - DC_RE S EN D_T I MEOU T ; 

} 

} 

else if (tDevice_Str [ *puchStrIndex] . usState [uchEventlndex] == 
DC__TRANS_ACK) 
{ 

if (uchEventlndex == DC_SECURE_EVENT ) 
{ 

*pusProcMsgId = DC_TRANS_TIMEOUT; 

} 

else if (uchEventlndex == DC_EUC2_EVENT) 
{ 

*pusProcMsgId = DC_EUC2_TIME0UT ; 

} 

} 

} 

else 
{ 

/* A device is still waiting for a response but has not timed out 

yet . 

Need to set time to wait on next UTREADQ call */ 



/* Note that ulWaitTime and MAX_WAIT are in milleseconds, ulTime is 

in seconds*/ 

ulTempTime = 

ulCurrentTime - 
tDevice_Str [uchMachinelndex] . ulTime [uchEventlndex] ; 
if (ulTempTime == 0) 
{ 

ulTempTime = ulWaitTime * 1000; 

} 

else 
{ 

ulTempTime = ulTempTime * 1000; 

} 

*pulWaitTime = 

( (*pulWaitTime) < ulTempTime) ? ( *pulWaitTime ) : ulTempTime; 

} 

} 

return usCheck for timeouts; 



* Module: DC_ProcTranTimeout 

* Desc: Process a timeout waiting for a transaction from a machine. 

* Inputs: uchStrlndex Index into DEVICE__STR for this machine 

* uchMachine Machine number 

* ulCurrentTime Current timestamp 

* Outputs: pusMsgSent set to TRUE if a message is sent out. This is used to 
determine 

* how long to wait on next DosReadQueue 

* Errors: Default Error Processing. 



VOID 



DC ProcTranTimeout 



( UCHAR uchMachine, UCHAR uchStrlndex, 
ULONG ulCurrentTime, PUSHORT pusMsgSent) 



ULONG 

FE P_MSG__HEADER 
INT 



ulStatus ; 

DC_Request_Msg; 

iVer; 



if (tDevice_Str [uchStrlndex] . usState [ DC_SECURE_EVENT] == DC_TRANS_ACK) 
{ 

/* Resend if we have not already sent this 3 times */ 
if {tDevice_Str [uchStrlndex] . usRetryCount [ DC_SECURE_EVENT] < 
DC_MAX__RETRY) 
{ 

++tDevice_Str [uchStrlndex] . usRetryCount [ DC_SECURE_EVENT] ; 

/* Just request a transaction again (start over at block zero) */ 

tDevice__Str [uchStrlndex] . usTransIndex = 0; 

tDevice_Str [uchStrlndex] .uchBlock = 0; 

DC__Request_Msg. uchBlock = tDevice_Str [uchStrlndex] . uchBlock; 
ulStatus = UtOrderTrans ( (PVOID) &tDevice_Str [uchStrlndex] .usSeqNum, 



( PVOID ) &DC_Request__Msg . usSeqNum, 
sizeof (short), sizeof (short)); 

/* request next DC transaction from the device */ 
ulStatus = STATCommlnitVer (uchMachine, &iVer) ; 
if (iVer) 
{ 

ulStatus = FEPMessage (0, (UINT) uchMachine, TX_DC_TRAN, 

sizeof ( DC_Request_Msg) , 
&DC_Request_Msg, 0) ; 

if (ulStatus != 0) 
{ 

SH_REPORT_EVENT ( WARN I NG_E VENT , SH_STATUS__SWERR, 
SH_STATUS_IGNORE, ulStatus, 
"Error Returned by FEPMessage"); 

} 

else 
{ 

sprint f (auchTmpMsg, 

"SMADDEB. . . Resend Request for DC Trans, device 

%2i. ", 

uchMachine) ; 
SH_REPORT_EVENT (ETDebugOutput, 

MC_S TAT U S_NONE , MC_S TAT US_I G NORE , 
(APIRET) 0, auchTmpMsg); 

} 

} 

tDevice_Str [uchStrlndex] . usTryAgain = TRUE; 

tDevice_Str [uchStrlndex] . ulTime [DC_SECURE_EVENT] = ulCurrentTime; 
*pusMsgSent = TRUE; 

} 

else if (tDevice_Str [uchStrlndex] . usTryAgain) 
{ 

/* Request starting from first block of new message */ 
DC_SendTranReq ( &tDevice_St r [uchStrlndex] , 

uchMachine, ulCurrentTime) ; 
*pusMsgSent = TRUE; 

} 

else 
{ 

/* Clean up and go back to idle state. */ 

tDeviceJStr [uchStrlndex] . usRetryCount [DC_SECURE_EVENT] = 0; 
tDevice_Str [uchStrlndex] . ulTime [DC_SECURE_EVENT] = ULONG_MAX; 
tDevice__Str [uchStrlndex] . usState [ DC_SECURE_EVENT] = DC_IDLE; 

SH_REPORT_EVENT ( WARNING_EVENT , SH__STATUS_SWERR, 

SH_STATUS_IGNORE , ( ULONG ) uchMachine , 
"Timeout Waiting for DC Transaction from 

Device" ) ; 

} 

} 

else 

{ /* Wrong state, just set flag to check for timeouts. */ 
*pusMsgSent = TRUE; 

} 



} 



* Module: DC_Proc_Trans 

Process a Debit /Credit message from device: either request next 



* Desc 
block 



or if this is the last block then send it on to the CC . 



* Inputs : 
Message, 



DC_TRANS__RESPONSE *ptDC_Trans_Msg Pointer to Device Response 



uchStrlndex, 
usProcMsgld 
uchMachine 
ulCur rent Time 



Index into Device_Str for this machine. 
Message Code (can be ab EUC1 or EUC6) 
Machine number 
Current timestamp 



* Outputs: NONE, messages are sent to the device or to the CC. 



* Errors: Default Error Processing. 

VOID DC_Proc_Trans ( DC_TRANS_RESPONSE *ptDC_Trans_Msg, 

UCHAR uchMachine, 
UCHAR uchStrlndex, 
ULONG ulCurrentTime, 
USHORT usProcMsgld) 



USHORT 

USHORT 

USHORT 

USHORT 

ULONG 

ULONG 

UCHAR 

UCHAR 



usCRC; 

usSeqNum = 0; 
usDataSize; 
us Temp; 
ulStatus ; 
ullndex; 

auchlnfo [DSM_INFO_SIZE] ; 
uchMsgType ; 



FEP_MSG_HEADER DC_Request_Msg; 

MSG_C_HEADER *ptCC_MsgHdr ; 

PUCHAR pauchRefNum; 

INT iVer; 

INT iSecure; 

BOOL bcardbenef it ; 



if (tDevice_Str [uchStrlndex] . usState [ DC_SECURE_EVENT] != DC_TRANS_ACK) 

{ /* Wrong state to accept a response. */ 

/* What happens if we get out of synch, how to get state back to idle */ 

if (tDevice_Str [uchStrlndex] . ulErrorCount < ULONG_MAX) 

{ 

++tDevice_Str [uchStrlndex] . ulErrorCount ; 

} 

if (ulDC^Debug) 
{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE, MC_STATUS_IGNORE, 
{ APIRET ) uchMachine , 



"SMADDEB. . .Trans msg rcvd- internal state error."); 

} 

} 

else /* Correct state to proceed */ 
{ 

usCRC - 0; 

/* Get the msg seq num from the header into the correct byte order */ 
ulStatus = UtOrderTrans ( ( PVOID) &ptDC_Trans_Msg->EUC_Msg . tHDR . usSeqNum, 

( PVOID) &usSeqNum, sizeof (short), sizeof 

(short) ) ; 

/* Get the CRC from the header into the correct byte order */ 
ulStatus = UtOrderTrans ( ( PVOID) &ptDC_Trans__Msg->EUC_Msg . tHDR . usCRC, 

(PVOID) &usCRC, sizeof (short), sizeof (short)); 
/* get the size in the correct byte order */ 
usDataSize = 0; 

ulStatus = UtOrderTrans ( ( PVOID) &ptDC_Trans_Msg->EUC_Msg . tHDR . us Length, 

(PVOID) &usDataSize, sizeof (short), sizeof (short)) 



if (usDataSize > FEP_MAX_MSG_SIZE) 
{ 

usTemp = -usCRC; 
sprintf (auchTmpMsg, 

"DC Trans invalid size in header, device %2i.", 
uchMachine) ; 
SH_REPORT_EVENT (ETDebugOutput , 

MC_STATUS_NONE , MC_STATUS_IGNORE , 
(APIRET) usDataSize, auchTmpMsg); 

} 

else 
{ 

usTemp = SMADCalcCrc ( ( PUCHAR) &ptDC_Trans _Msg->EUC_Msg . auchData , 

usDataSize) ; 
} 

/* check that the CRC is correct */ 

if (usCRC != usTemp) 

{ 

/*if (ulDC_Debug) */ 
{ 

/* CRC error */ 

SH_RE PORT_E VENT ( WARNING_EVENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE , uchMachine , 
"CRC Mismatch on DC Trans"); 

} 

/* DO nothing and let it time out and send request again */ 

if (tDevice_Str [uchStrlndex] . ulErrorCount < ULONG_MAX) 

{ 

++tDevice_Str [uchStrlndex] . ulErrorCount; 

} 

} 

/* check for correct sequence number and block */ 
else if ( (usSeqNum != tDevice_Str [uchStrlndex] . usSeqNum) || 
(ptDC_Trans_Msg->EUC_Msg . tHDR. uchBlock ! = 
tDevice_Str [uchStrlndex] .uchBlock) ) 
{ 

/* The block or msg seq is wrong. 

DO nothing and let it time out and send request again */ 



if (tDevice_Str [uchStrlndex] . ulErrorCount < ULONG_MAX) 

{ 

++tDevice_Str [uchStrlndex] . ulErrorCount; 

} 

if (ulDC_Debug) 
{ 

SH_REPORT_EVENT ( ETDebugOutput , 

MC_STATUS__NONE, MC_STATUS_IGNORE , 
(APIRET) uchMachine, 

"SMADDEB ... DC Trans MSN Error."); 

} 

} 

else 
{ 

/* Response is OK , go ahead and process */ 

ullndex = tDevice_Str [uchStrlndex] . usTransIndex; 

/* Copy this block of the message into the saved EUC message 

structure */ 

if (pt DC_Trans_Msg->EUC_Msg . tHDR. uchBlock == 0) 
{ 

/* copy the header and the data if this is the first block 
usDataSize += MSG_C_HEADERSIZE; 

memcpy ( &tDevice__Str [uchStrlndex] . uchExt_TRANS [ullndex] , 
&ptDCJTrans_Msg->EUC_Msg. tHDR, 
usDataSize) ; 

} 

else if ((ullndex + usDataSize <= DC_TRANS_MAX_SIZE) ) 
{ 

/* After the first block only copy the data */ 

memcpy ( &t Device_Str [uchStrlndex] . uchExt_TRANS [ullndex] , 

&ptDC__Trans_Msg->EUC_Msg. auchData, 

usDataSize) ; 

} 

ullndex += usDataSize; 

tDevice_Str [ uchStrlndex] . usTransIndex = ullndex; 
++tDevice_Str [uchStrlndex] . uchBlock; 

if (ptDC_Trans_Msg->EUC_Msg. tHDR.uchLast == 0) 
{ 

/* Not the last block, go get the next one */ 
DC_Request_Msg . uchBlock = tDevice_Str [uchStrlndex] . uchBlock 
ulStatus = 

UtOrderTrans ( (PVOID) &tDevice_Str [uchStrlndex] .usSeqNum, 

( PVOID) &DC_Request_Msg . usSeqNum, 
sizeof (short), sizeof (short)); 
/* request next DC transaction from the device */ 
ulStatus = STATCommlnitVer (uchMachine, &iVer) ; 
if (iVer) 
{ 

ulStatus = FEPMessage (0, (UINT) uchMachine, TX_DC_TRAN 

sizeof ( DC_Request_Msg) , 
&DC_Request_Msg, 0) ; 

if (ulStatus != 0) 
{ 

SH_REPORT_EVENT ( WARN I NG_E VENT , SH_STATUS_SWERR, 
SH_STATUS_IGNORE, ulStatus, 
"Error Returned by FEPMessage"); 



} 

} 

tDevice_Str [uchStrlndex] . usTryAgain = FALSE; 
tDevice_Str [uchStrlndex] . ulTime [ DC_SECURE_EVENT] = 

ul Cur rent Time; 

} 

else if (ptDC_Trans_Msg->EUC_Msg. tHDR.uchLast > 0) 
{ 

/* check for a invalid message size*/ 

if (ul Index > MSG_MAX_LENGTH) 

{ 

/* some error with sending the transaction */ 
SH_REPORT_EVENT ( WARN I NG_EVENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE, ullndex, 
"Invalid size for DC transaction. ") ; 
ullndex = MSG_MAX_LENGTH; 

} 

/* Send on to SHDBCRDT if this is the last block of the message 

*/ 

/* Need to update some fields in the EUC header */ 
ptCCJMsgHdr = (MSG_C_HEADER *) 
&tDevice_Str [uchStrlndex] . uchExt_TRANS [ 0 ] ; 

/* Put in the final message size in header */ 
ullndex - ullndex - MSG__C_HEADERSIZE ; 
ulStatus = UtOrderTrans ( (PVOID) &ullndex, 

(PVOID) &ptCC_MsgHdr->length, 
sizeof (short), sizeof (short)); 

/* Only one CC comms block needed for EUC messages */ 

ptCC_MsgHdr->last_block = 1; 

/* Set the seq num to zero */ 

ptCC_MsgHdr->sequence_no. v = 0; 

/* check if this is and EUBx or and EUCx */ 

bcardbenefit = (ptCC_MsgHdr->type [MSG_ID_TYPE__MAX-2 ] == 

DC_EBCDIC_B) ; 

/* get EUC msg type (1 to 6) V 

uchMsgType = ptCC_MsgHdr->type [MSG_ID_TYPE_MAX-1 ] - 

DC_EBCDIC_ZERO; 

/* start at pointer to 1st byte and add the offset to 

the RETRIEVAL REFERENCE NUMBER dependant upon which EUC 



message 



type this is */ 
pauchRefNum = (PUCHAR) &ptCC_MsgHdr->type [ 0 ] ; 



if (bcardbenefit) 
{ 

switch (uchMsgType) 
{ 

case 1: 

pauchRefNum += DC_EUB1_RET_REFJDFFSET; 
break; 
case 5 : 

pauchRefNum += DC_EUB5_RET_REF_OFFSET; 
break; 



case 3: 

pauchRefNum += DC_EUB3_RET__REF_0FFSET; 
break; 
default : 

pauchRefNum = 0; 
break; 

} 

} 

else 
{ 

switch (uchMsgType) 
( 

case 1: 
case 6: 

pauchRefNum += DC_EUC1_RET_REF_0FFSET; 
break; 
case 5: 

pauchRefNum += DC_EUC5_RET_REF_OFFSET ; 

break; 
case 3: 
case 4 : 

pauchRefNum DC_EUC3_RET_REF__OFFSET; 
break; 
default : 

pauchRefNum = 0; 
break; 

} 

} 

if (pauchRefNum == 0) 
{ 

if (ulDC_Debug) 
{ 

SH_REPORT_EVENT (ETDebugOutput, 

MC_STATUS_NONE , MC_STATUS__IGNORE , 
(APIRET) uchMachine, 

"SMADDEB . . .DC Trans Unknown Message. ") ; 

} 

} 

else 
{ 

/* build the CICS Trans Number */ 
DC_Create_DSM_Index ( pauchRefNum, 

uchMsgType, 

uchMachine, 

(PUCHAR) &auchlnfo[0] , 
(PULONG) & (ptCC_MsgHdr- 

>cics_trans_no . v) ) ; 

/* Save the retrieval reference number for subsequent comms 

with 

the device. */ 
memcpy ( &t Device__Str [uchStrlndex] . uchSecureRefNo, 
pauchRefNum, 

RETRIEVAL_REF_NUMBER_MAX) ; 

/* send it to host */ 
ullndex += MSG C HEADERSIZE; 



iSecure = DBCRDT_SendToHost ( ( PUCHAR) &ptCC_MsgHdr- 

>type [ 0] , ul Index, 

{ PUCHAR) Sauchlnfo) ; 

if (! iSecure) 
{ 

/* some error with sending the transaction to 

SHDEBCREDV 

if ( tDevice_Str [uchStrlndex] . ulErrorCount < ULONG_MAX) 
{ 

++t Devi ce_Str [uchStrlndex] . ulErrorCount ; 

} 

/* some error with sending the transaction */ 
SH_REPORT_EVENT ( WARN I NG_E VENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE, ulStatus, 
"DC Thread can not send to host") ; 

/* 

Not much can be done here, just make sure a SECURE 

message 

is not sent to the device and keep requesting 

transactions 

as if everything was OK 

*/ 

} 

/* Check that device is past the comms init stage */ 

/* then send the DC_SECURE message to let device go on to 

next trans. */ 

ulStatus = STATCommlnitVer (uchMachine, &iVer) ; 

if (iVer) 

{ 

if ( (usProcMsgld == DC_TRANS ) && (iSecure) ) 
{ 

/* For EUB5, EUC3, EUC4, and EUC5 send 

TX_DC_SECURE_REQ */ 

ulStatus = FEPMessage ( 
0, (UINT) uchMachine, 
TX_DC_SECURE, 
RE T R I E VAL_RE F_N UMB E R__MAX , 

&tDevice_Str [uchStrlndex] . uchSecureRefNo [ 0] , 

0); 

if (ulStatus != 0) 
{ 

SH_REPORT_EVENT ( WARNING_EVENT , 

SH_STATUS_SWERR, 

SH_STATUS_IGNORE, ulStatus, 
"Error Returned by FEPMessage"); 

} 

else 
{ 

if (ulDC_Debug) 
{ 

sprintf (auchTmpMsg, "SECURE : " ) ; 
/*Write_Log_Msg ( "del .hex", auchTmpMsg, 
(PUCHAR) 

&tDevice_Str [uchStrlndex] . uchSecureRefNo [ 0 ] , 

RE T R I E VAL_RE F_N UMB E R_MAX ) ; */ 

} 

} 



again */ 



if (ptDCJTrans_Msg->EUC_Msg. tHDR.uchLast > 1) 
{ 

/* If more messages, then set flag to request 



tDevice_Str [uchStrlndex] .usTryAgain = TRUE; 



} 

else 
{ 



tDevice_Str [uchStrlndex] .usTryAgain = FALSE; 



} 



DC_WAITING_ACK; 
ulCur rent Time; 



/* Change state to waiting for ACK on SECURE msg */ 
tDevice_Str [uchStrlndex] . us State [ DC_SECURE_EVENT] = 

tDevice Str [uchStrlndex] . ulTime [ DC SECURE EVENT] = 



tDevice_Str [uchStrlndex] . usRetryCount [ DC_SECURE_EVENT] 



0; 



( ! iSecure) ) 

transaction . 
*/ 

uchMachine, 



DC_I DLE ; 
ULONG MAX; 



} 

else if ( (pt DC_Trans_Msg->EUC_Msg . tHDR. uchLast > 1) || 
{ 

/* If more message bit is set... */ 

/* For EUB1, EUC1 and EUC6 just request the next 

/* Request starting from first block of new message 

DC__SendTranReq ( &tDevice_Str [uchStrlndex] , 

ulCurrentTime ) ; 

} 

else 
{ 

tDevice_Str [uchStrlndex] . usTryAgain = FALSE; 
tDevice_Str [uchStrlndex] . usState [DC_SECURE_EVENT] = 

tDevice St r [uchStrlndex] . ulTime [ DC SECURE EVENT] = 



tDevice_Str [uchStrlndex] . usRetryCount [ DC_SECURE_EVENT] = 0; 

} 

} 



} 

/*************************************^ 

* Module: DC_ProcEUC2 

* Desc: Store and forward an EUC2 Message received from CC destined to a 
device . 

* Message must be broken into multiple blocks. 



* Inputs: uchStrlndex 



Index into DEVICE STR for this machine 



* uchMachine Machine number 

* ulCurrentTime Current timestamp 

* Outputs: NONE, 
+ 

* Errors: Default Error Processing. 

VOID DC_ProcEUC2 { UCHAR uchMachine, UCHAR uchStrlndex, 

ULONG ulCurrentTime, DC_EXTERNAL_EUC_MSG *ptDC_Ext JEUCJYIsg) 

{ 



INT 

INT 

ULONG 

USHORT 

USHORT 

TX_MULT I_BLOCK_MSG 
BOOL 



iRemSi ze ; 
iMsgSize; 
ulStatus / 
usDataSize; 
usCRC; 

DC_EUC_ToDevice; 
bcardbenef it ; 



/* EUC2 received from SHDBCRED ( SendToDevice ) */ 

if (tDevice__Str [uchStrlndex] .usState [DC_EUC2_EVENT] == DC_IDLE) 
{ 

/* start sending the msg */ 
tDevice_Str [uchStrlndex] . usBytePtr = 0; 

tDevice_Str [uchStrlndex] . iOrgSize = ptDC_Ext_EUC_Msg->usSize ; 
tDevice_Str [uchStrlndex] . iMsgSize = ptDC_Ext_EUC_Msg->usSize ; 
++tDevice_Str [uchStrlndex] . usC2SeqNum; 

tDevice_Str [uchStrlndex] . usRetryCount [DC_EUC2_EVENT] = 0; 

memcpy ( &tDevice_Str [uchStrlndex] . EUC2 , 
&ptDC_Ext_EUC_Msg->tHDR, 
ptDC_Ext_EUC_Msg->usSize) ; 
tDevice_Str [uchStrlndex] .ulEUC2_CICS = 

ptDC_Ext_EUC_Msg->tHDR. cics_trans_no. v; 



/* Copy the message into this msg block to be sent to device. */ 
iRemSize - tDevice_Str [ uchStrlndex] . iMsgSize ; 
iMsgSize = 

( iRemSize < MAX_ME S SAG E_S I Z E ) ? iRemSize : MAX_MESSAGE_SIZE; 
memcpy ( &DC_EUC_ToDevice . tHDR, 

&tDevice_Str [uchStrlndex] . EUC2 [ tDevice_Str [uchStrlndex] . usBytePtr] , 
iMsgSize) ; 
DC_EUC_ToDevice . tHDR. uchBlock = 0; 
tDevice_Str [uchStrlndex] . uchC2Block = 0; 
if (iMsgSize == iRemSize) 
{ 

DC_EUC_ToDevice . tHDR . uchLast = 1; 

} 

else 
{ 

DC_EUC_ToDevice. tHDR. uchLast = 0; 

} 



/* Size of data is msg size minus the header size */ 

usDataSize - iMsgSize - MSG_C_HEADERSIZE; 

ulStatus = UtOrderTrans ( ( PVOID) &usDataSize, 

(PVOID) &DC_EUC__ToDevice . tHDR . usLength, 
sizeof (short), sizeof (short)); 

ulStatus = UtOrderTrans ( ( PVOID) &tDevice_Str [uchStr Index] . usC2SeqNum, 

( PVOID) &DC_EUC_ToDevice . tHDR . usSeqNum, 
sizeof (short), sizeof (short)); 



/* Calculate the CRC on the data portion of the message */ 

usCRC = SMADCalcCrc( ( PUCHAR) &DC_EUC_ToDevice . auchData , usDataSize) ; 

ulStatus = UtOrderTrans ( ( PVOID) &usCRC, 

(PVOID) &DC_EUC_ToDevice. tHDR. usCRC, 
sizeof (short), sizeof (short)); 



/* Send the mesage to the device via the SMADFEP Thread */ 
ulStatus - FEPMessage (0, (UINT) uchMachine, TX_DC_AUTHORIZE, 

iMsgSize, &DC__EUC_To Device, 0); 

if (ulStatus != 0) 
{ 

SH_REPORT_EVENT { WARN I NG_EVENT , SH_STATUS_SWERR, 
SH_STATUS_IGNORE, ulStatus, 
"Error Returned by FEPMessage"); 

} 

else 
{ 

tDevice_Str [uchStrlndex] . usState [ DC_EUC2_EVENT] = DC_T RAN S _AC K ; 
tDevice_Str [uchStrlndex] . ulTime [ DC_EUC2_EVENT] = ulCurrentTime ; 
if (ulDC_Debug) 
{ 

/* check if this is and EUBx or and EUCx */ 

bcardbenefit = (ptDC_Ext_EUC_Msg->tHDR . type [MSG_ID_TYPE_MAX-2 ] 

== DC_EBCDIC_B) ; 

if (bcardbenefit) 
{ 

sprint f (auchTmpMsg, 
"SMADDEB. . . EUB2 Block %li Sent to Device %2i", 
ulStatus, uchMachine) ; 

} 

else 
{ 

sprint f (auchTmpMsg, 
"SMADDEB. . .EUC2 Block %li Sent to Device %2i", 
ulStatus, uchMachine); 

} 

SH_REPORT_EVENT ( ETDebugOutput , 

MC_STATUS_NONE, MC_STATUS_IGNORE, 
(APIRET) uchMachine, auchTmpMsg); 

} 

} 

} 

else 



/* do not send a NAK back to CC, let it timeout */ 

if (tDevicejStr [uchStrlndex] . ulErrorCount < UL0NGJY1AX) 

{ 

++tDevice_Str [uchStrlndex] . ulErrorCount; 

SH_REPORT_EVENT ( WARN I NG_EVENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE , ( ULONG ) uchMachine , 
"Auhtorization Received but DC Thread is busy") 



} 

* Module: DC_ProcEUC2_ACK 

* Desc: Process an ACK of a EUC2 message block sent to the device. 

* If more blocks to send, continue with next block. 



Inputs : 



uchStrlndex 
uchMachine 
ul Cur rent Time 



Index into DEVICE_STR for this machine 
Machine number 
Current times tamp 



* Outputs: pusMsgSent set to TRUE if a message is sent to the device. 

* Errors: Default Error Processing. 

VOID DC_ProcEUC2_ACK (UCHAR uchMachine, UCHAR uchStrlndex, 

ULONG ulCurrentTime, PUSHORT pusMsgSent) 



INT 

INT 

ULONG 

USHORT 

USHORT 

TX_MULTI_BLOCK_MSG 
UCHAR 

MSG_C_MACK 
BOOL 



iRemSize; 
iMsgSize; 
ulStatus; 
usDataSize ; 
usCRC; 

DC_EUC_ToDe vice ; 
auchInfo[DSM_INFO__SIZE] ; 
DCJtfACK_Msg; 
bcardbenef it / 



sending the message */ 

Str [uchStrlndex] . uchC2Block == 0) 

Str [uchStrlndex] . usBytePtr += MAX_MESSAGE_SI ZE; 
Str [uchStrlndex] . iMsgSize -= MAX_MESSAGE_SIZE; 



/* continue 
if (tDevice_ 
{ 

tDevice_ 
tDevice_ 
} 

else 

{ /* If not first block, subtract out header size since header is resent 
eith each block */ 
tDevice_Str [uchStrlndex] .usBytePtr += 

(MAX_MESSAGE_S I ZE-MSG_C_HEADERS I ZE ) ; 
tDevice_Str [uchStrlndex] .iMsgSize -= 

( MAX_MESSAGE_S I Z E-MSG_C_HEADERS I ZE ) ; 

r [uchStrlndex] .uchC2Block; 

ear retry count, avoid the infinite loop of NAK/ACK/NAK/ACK */ 
r [uchStrlndex] . usRetryCount [DC EUC2 EVENT] = 0/ */ 



} 

++tDevice_St 
/* do not cl 
/*tDevice St 



if (tDevice_Str [uchStrlndex] . iMsgSize > 0) 
{ 

/* Send the next block */ 

/* Copy the message into this msg block to be sent to device. */ 
iRemSize = tDevice_Str [uchStrlndex] . iMsgSize + MSG_C_HEADERSI ZE; 
iMsgSize = 

{ iRemSize < MAX_MESSAGE_SIZE) ? iRemSize : MAX__MESSAGE_SI ZE ; 
/* Copy the header portion into all blocks */ 
memcpy ( &DC_EUC_ToDevice . tHDR, 

&tDevice_Str [uchStrlndex] . EUC2 [0] , 

MSG__C_HEADERSI ZE) ; 
/* Size of data is msg size minus the header size */ . 
usDataSize = iMsgSize - MSG_C_HEADERSIZE; 
memcpy ( &DC_EUC_ToDevice . auchData, 

&tDevice_Str [uchStrlndex] . EUC2 [ tDevice_Str [uchStrlndex] .usBytePtr] , 
usDataSize ) ; 

DC_EUC_ToDevice . tHDR . uchBlock = tDevice_Str [uchStrlndex] .uchC2Block; 

if (iMsgSize == iRemSize) 
{ 

DC_EUC_ToDevice . tHDR . uchLast = 1; 

} 

else 
{ 

DC_EUC_ToDevice . tHDR. uchLast = 0; 

} 

ulStatus = UtOrderTrans ( ( PVOID) &usDataSize, 

{ PVOID) &DC_EUC_ToDevice . tHDR. usLength, 
sizeof (short) , sizeof (short) ) ; 

/* Calculate the CRC on the data portion of the message */ 

usCRC - SMADCalcCrc( ( PUCHAR) &DC_EUC_ToDevice . auchData, usDataSize) ; 

ulStatus = UtOrderTrans ( (PVOID) &usCRC, 

(PVOID) &DC_EUC_ToDevice . tHDR. usCRC, 
sizeof (short), sizeof (short)); 

ulStatus = UtOrderTrans (( PVOID) &tDevice_Str [uchStrlndex] . usC2SeqNum, 

( PVOID) &DC_EUC_ToDevice . tHDR . usSeqNum, 
sizeof (short), sizeof (short)); 



/* Send the mesage to the device via the SMADFEP Thread */ 
ulStatus = FEPMessage (0, (UINT) uchMachine, TX_DC_AUTHORIZE, 

iMsgSize, 

&DC_EUC_ToDevice, 0) ; 

if (ulStatus != 0) 
{ 

SH_REPORT_EVENT ( WARNING__EVENT, SH_STATUS_SWERR, 
SH_STATUS__IGNORE , ulStatus , 
"Error Returned by FEPMessage"); 

} 

else 
{ 



tDevice_Str [uchStrlndex] . ulTime [DC__EUC2_EVENT] = ulCurrentTime ; 

*pusMsgSent = TRUE; 
if <ulDC_Debug) 
{ 

/* check if this is and EUBx or and EUCx */ 

bcardbenefit = (tDevice_Str [uchStrlndex] . EUC2 [MSG_ID_TYPE_MAX- 
2] == DC_EBCDIC_B) ; 

if (bcardbenefit) 
{ 

sprintf (auchTmpMsg, 

"SMADDEB. . .EUB2 Block %li Sent to Device %2i", 
(INT) DC_EUC_ToDevice . tHDR . uchBlock, (INT) uchMachine) ; 

} 

else 
{ 

spr int f (auchTmpMsg , 

" SMADDEB. . .EUC2 Block %li Sent to Device %2i", 
(INT) DC_EUC_ToDevice.tHDR. uchBlock, (INT) uchMachine) ; 

} 

SH_REPORT_EVENT (ETDebugOutput , 

MC_STATUS_NONE, MC_STATUS_IGNORE, 
(APIRET) uchMachine, auchTmpMsg) ; 

} 

} 

} 

else 
{ 

/+ Send a MACK to SHDEBCRD */ 

/* EUC2 is recvd at vendor, send a MACK back to the CC */ 
/* Add ' EUC2 ' to mack */ 

LIB__cnv_ascii_to__ebcdic (MSG_ID_MACK, (PUCHAR) &DC_MACK_Msg . mack_id, 

MSG_ID_TYPE_MAX) ; 
memcpy ( & DC_MACK_Msg . type , 

&tDevice_Str [uchStrlndex] . EUC2 [0] , 

MSG_IDJTYPE_MAX) ; 
/* Add CICS trans no to MACK */ 

DC_MACK_Msg. cics_trans_no . v = tDevice__Str [uchStrlndex] . ulEUC2_CICS ; 
DC_MACK_Msg. status = MSG_ACKSTS_OK; 

if (DBCRDT_SendToHost ( (PUCHAR) &DC_MACK_Msg, (ULONG) 
MSG_C_MACKSIZE, (PUCHAR) &auchInfo) ) 
{ 

ulDC_Debug = ulDC_Debug; 

} 

else 
{ 

SH_REPORT_EVENT ( WARNING_EVENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE, (APIRET) 0, 
"DC Thread can not MACK to host"); 

} 

tDevice_Str [uchStrlndex] . usState [ DC_EUC2_EVENT] = DC_IDLE; 
tDevice_Str [uchStrlndex] . usRet ryCount [ DC_EUC2_EVENT] = 0; 
tDevice_Str [uchStrlndex] . ulTime [DC EUC2 EVENT] = ULONG MAX; 



} 



* Module: 

* Desc: 
device . 



DC_ProcEUC2__NAK 

Process an NAK or timeout of a EUC2 message block sent to the 
If retry count has not been exceeded, continue with same block. 



Inputs : 



uchStrlndex 
uchMachine 
ulCur rent Time 



Index into DEVICE__STR for this machine 
Machine number 
Current timestamp 



* Outputs: pusMsgSent set to TRUE if a message is sent to the device. 
* 

* Errors: Default Error Processing. 

VOID DC_ProcEUC2_NAK (UCHAR uchMachine, UCHAR uchStrlndex, USHORT 
usProcMsgld, 

ULONG ulCurrentTime, PUSHORT pusMsgSent) 

{ 



INT 

INT 

INT 

ULONG 

USHORT 

USHORT 

TX_MULTI_BLOCK_MSG 
UCHAR 

MSG C MACK 



iRemSize; 

iMsgSize; 

iTmpPtr; 

ulStatus; 

usDataSize; 

usCRC; 

DC_EUC_ToDevice ; 
auchlnfo [ DSM_INFO_SI ZE] ; 
DC_MACK Msg; 



/* continue sending the same block of the message */ 

/* resend the same block, increment number of times this block sent */ 
if (tDevice_Str [uchStrlndex] . usRetryCount [ DC_EUC2_EVENT] < 
DC_EUC2_MAX_RETRY ) 
{ 



++ (tDevice_Str [uchStrlndex] . usRetryCount [DC_EUC2_EVENT] ) ; 

/* Send the next block */ 

/* Copy the header portion */ 

memcpy ( &DC_EUCJToDevice . tHDR, 

&tDevice_Str [uchStrlndex] . EUC2 [0] , 

MSG_C_HEADERS I ZE ) ; 

iTmpPtr = tDevice_Str [uchStrlndex] . usBytePtr; 

if (usProcMsgld == DC_EUC2_NAK) 

{ 

/* restart sending at start of message if a NAK */ 
tDevice_Str [uchStrlndex] . usBytePtr = 0; 
iTmpPtr = MSG_C_HEADERSIZE; 
tDevice_Str [uchStrlndex] .uchC2Block = 0; 
tDevice_Str [uchStrlndex] .iMsgSize = 
tDevice_Str [uchStrlndex] . iOrgSize; 
} 

/* Copy the message into this msg block to be sent to device. */ 

if (tDevice_Str [uchStrlndex] .uchC2Block == 0) 

{ 



iRemSize = tDevice_Str [uchStrlndex] . iMsgSize; 

} 

else 
{ 

/* If not at block zero, copy the header and data from where 

the last block left off */ 
iRemSize = tDevice_Str [uchStrlndex] . iMsgSize + MSG_C_HEADERSIZE; 

} 

iMsgSize = 

( iRemSize < MAX_MESSAGE_SIZE) ? iRemSize : MAX_MESSAGE_SIZE; 
/* Size of data is msg size minus the header size */ 
usDataSize = iMsgSize - MSG_C_HEADERSI ZE; 
/* Copy the data portion of the message */ 
memcpy ( &DC_EUC__ToDevice . auchData, 

&tDevice_Str [uchStrlndex] . EUC2 [ iTmpPtr ] , 
usDataSize) ; 
if (iMsgSize == iRemSize) 
< 

DC_EUC_ToDe vice. tHDR. uchLast = 1; 

} 

else 
{ 

DC_EUC_ToDevice . tHDR. uchLast = 0; 

} 

DC_EUC_ToDevice . tHDR. uchBlock = tDevice_Str [uchStrlndex] .uchC2Block; 

ulStatus = UtOrderTrans ( { PVOID) SusDataSi ze, 

(PVOID) &DC_EUC_ToDevice. tHDR. usLength, 
sizeof (short), sizeof (short)); 

/*■ Calculate the CRC on the data portion of the message */ 

usCRC - SMADCalcCrc( ( PUCHAR) &DC_EUC_ToDevice . auchData, usDataSize) ; 

ulStatus = UtOrderTrans ( ( PVOID) &usCRC, 

(PVOID) &DC_EUC_ToDevice. tHDR.usCRC, 
sizeof (short), sizeof (short)); 

ulStatus = UtOrderTrans (( PVOID) &tDevice_Str [uchStrlndex] . usC2SeqNum / 

( PVOID) &DC_EUC_ToDevice . tHDR . usSeqNum, 
sizeof (short), sizeof (short)); 



/* Send the message to the device via the SMADFEP Thread */ 
ulStatus = FEPMessage (0, (UINT) uchMachine, TX_DC_AUTHORIZE, 

iMsgSize, 

&DC_EUC_ToDevice, 0) ; 

if (ulStatus != 0) 
{ 

/* Just wait and timeout to try again */ 
SH_REPORT_EVENT ( WARN I NG_EVENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE, ulStatus, 

"Error Returned by FEPMessage"); 

} 

else 
{ 

sprint f (auchTmpMsg, 

"SMADDEB. . . Resend Authorization Block %li Sent to Device 



(INT) DC_EUC_ToDevice . tHDR. uchBlock, (INT) uchMachine) ; 
SH_REPORT_EVENT ( ETDebugOutput , 

MC_STATUS_NONE, MC_STATUS_IGNORE , 
(APIRET) uchMachine, auchTmpMsg) ; 

} 

tDevice_Str [uchStrlndex] . ulTime [DC_EUC2_EVENT] = ulCurrentTime; 
*pusMsgSent = TRUE; 

} 

else 
{ 

/* Time to give up on sending the EUC2 */ 
/* Send a MACK to SHDEBCRD */ 
/* Add ' EUC2 1 to mack */ 

LIB_cnv_ascii_to_ebcdic (MSG_ID_MACK, (PUCHAR) &DC_MACK_Msg . mack_id, 

MSG__ID_TYPE_MAX) ; 
memcpy (&DC_MACK_Msg. type, 

&tDevice_Str [uchStr Index] . EUC2 [0] , 

MSG_ID_TYPE_MAX) ; 
/* Add CICS trans no to MACK */ 

DC_MACK_Msg.cics_trans_no. v = tDevice^Str [uchStrlndex] . ulEUC2_CICS ; 
DC_MACK_Msg. status = MSG_ACKSTS_ABORT; 
if (DBCRDT_SendToHost { (PUCHAR) &DC_MACK_Msg, (ULONG) 
MSG_C_MACKSIZE, (PUCHAR) &auchInfo) ) 
{ 

if (ulDC_Debug) 
{ 

if (tDevice_Str [uchStrlndex] . EUC2 [MSG_ID_TYPE_MAX-2 ] == 

DC_EBCDIC_B) 

{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE, MC_STATUS_IGNORE, 
(APIRET) 0, 

"SMADS info... DC EUB2 NAK sent to host"); 

} 

else 
{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE, MC_STATUS_IGNORE, 
(APIRET) 0, 

"SMADS info... DC EUC2 NAK sent to host"); 

} 

} 

} 

else 
{ 

SH_REPORT_EVENT ( WARNING_EVENT , SH_STATUS__SWERR, 

SH_STATUS_IGNORE, (APIRET) 0, 
"DC Thread can not send NAK to host"); 

} 

tDevice_Str [uchStr Index] . usRetryCount [ DC_EUC2_EVENT] = 0; 
tDevice_Str [uchStrlndex] . ulTime [ DC_EUC2_EVENT] = UL0NG_MAX; 
tDevice_Str [uchStrlndex] . usState [ DC_EUC2_EVENT] = DC_IDLE; 

} 

} 



* Module: DCThread 

* Desc: Debit/Credit Device Interface Thread 

* Handles all device communcations (via FEP thread) for Debit/Credit 

* messages. This includes : 

* DCJTRANS request (SMADS request to device to send a DC 
transaction) 

* DC_TRANS response (EUC3, EUC4, EUC5 , EUB3, EUB5 transaction 
block from device) 

* DC_AUTHORIZE request (EUB1, EUC1 or EUC6 message block from 
device) 

received OK) 
* 

deleteion) 
transactions ) 



DC_AUTHORIZE_ACK (ACK from device for EUC2 block) 
DC_SECURE request (SMADS message to device that DC_TRANS 

DC_SECURE response (Device ACK to DC_SECURE request message) 
DC_DELETE request (SMADS message to device to auhtorize DC Trans 

DC_DELETE response (Device ACK to DC_DELETE message) 
DC_RESEND (SMADS message to device to 're-send all available DC 



module ) 



This Thread also receives messages from other SMADS threads 
DC_EUC2 (EUC2 message from CC via SHDBCRDT module 

This results in a DC_AUTHORIZE msg out to device. 
MACK (CC confirms receipt of EUC3, EUC4, EUC5 via SHDBCRDT 



* This results in a DC_DELETE msg out to device. 

* DC_TRANS_GET (message from SMADSTAT thread to initiate getting a 
DC transaction . 

* 

* This thread will receive EUCx transactions sent from devices. 

* Since these may be in mutliple FEP blocks, this thread will receive 

* each block as it is sent and assemble the complete EUCx transaction. 
The complete transaction will then be passed on to the SHDBCRDT 



* 

module 



* for storage (if required) and forwarding to the CC . 

* This thread will respond to the device with a SECURE DEBIT/CREDIT 
TRANSACTION 

* message to acknowledge receipt at the SMADS. 

* This thread will also receive DELETE DEBIT/CREDIT TRANSACTION 
messages from the 

* SHDBCRDT_SendToDevice function to inform the device when a 
transaction has 

* been received at the CC, so that it can be deleted. These 
transactions will be 

* sent to the device and if a response from the device is not received 
within 

* the defined timeout period, the message will be re-sent to the 
device. Three 

* attempts will be made to send the message before it wil be thrown 
out . 

* Also, once a day (after opreational hours), this thread will send a 
RESEND 

* DEBIT/CREDIT TRANSACTION message to all devices as a safety measure 
to make sure 



* that the device does not have any left over debit credit 
transactions that have not 

* been yet deleted. Note that this could result in a duplicate EUCx 
transaction 

* being sent to the CC but the CC will resolve this any not process 

duplicates . 

* 

* Inputs: N/A 

* Outputs: N/A 

* Errors: Default Error Processing. 
********************************** 



VOID ENV_CDECL DCThread ( PVOID pvDummy) 
{ 

APIRET ulStatus; 



HQUEUE 
HEV 



ulDC_CCTX_Handle / 
DC QRead Sem; 



USHORT 
USHORT 
USHORT 
USHORT 
USHORT 
USHORT 
USHORT 
USHORT 
USHORT 
USHORT 
PUCHAR 

UCHAR 
UCHAR 
UCHAR 
UCHAR 
UCHAR 
UCHAR 
UCHAR 



usQlen; 

usMsgCode; 

usMsgSubcode; 

usProcMsgld; 

usMsgRead; 

usMsgSent ; 

u s Mo r e_t o_do ; 

usCheck_f or_timeouts; 

usFreeMsg; 

usRunning; 

puchData ; 

uchMachine; 
uchStart ; 
uchEnd; 

uchMachine I ndex ; 
uchEvent Index; 
uchStrlndex; 

auchInfo[DSM INFO SIZE] ; 



INT 
INT 
INT 
INT 
BOOL 



iQpri; 
ilNDXl; 
HNDX2; 
iVer ; 

bEUCO_Pending 



FALSE; 



ULONG 
ULONG 
ULONG 



ulWaitTime; 
ulPid; 

ulEUCO Time=0; 



TIME_T 
TIME_T 
TIME T 



ulResendTime ; 
ulCur rent Time; 
ulTempTime; 



DC SECURE DEL RESPONSE *ptDC ACK Msg; 



DC_TRANS_RESPONSE 

MSG_C_HEADER 

DC_DELJTRANS 

MSG_C_MACK 

DC_EXTERNAL_EUC_MSG 

struct msg_str 

REQUESTDATA 



*ptDC_Trans_Msg; 

EUCO_Msg; 

*ptDC_DelTrans; 

DC_MACK_Msg; 

*ptDC_Ext_EUC_Msg; 

*ptMsg; 

qdata; 



ulStatus = DosCreateEventSem ( NULL, &DC_QRead_Sem, OL, TRUE ); 

if (ulStatus != 0) 

{ 

usRunning = FALSE; 

SH_REPORT_EVENT { FATAL_EVENT , SH_STATUS_SWERR, 
SH_STATUS_IGNORE, ulStatus, 
"Error Returned by DosCreateEventSem"); 

} 



/* Bogus assignment to get rid of compile warning */ 
/* Actual assignment takes place in UtReadQ */ 
ptMsg = (struct msg_str *) &ulPid; 
usRunning - TRUE; 

ulStatus = UtReadQ (ulDEB__CRED_handle, 

&qdata, 
&usQlen, 
&usMsgCode , 
&usMsgSubcode, 
&puchData, 
NULL, 

(PVOID) &ptMsg, 
DC, 

&iQpri, 
DCWW_NOWAIT, 
&DC_QRead_Sem, 
0) ; 

if (ulStatus != 0) 
{ 

if (ulStatus != ERROR_QUE_EMPTY) 
{ 

usRunning - FALSE; 

SH__REPORT__EVENT ( FATAL_EVENT , SH_STATUS_SWERR, 
SH_STATUS_IGNORE, ulStatus, 
"Error Returned by UtReadQ"); 

} 

} 

/* Open a queue for sending messages to SMAD CCTX Thread */ 

do 

{ 

ulStatus = DosOpenQueue (&ulPid, &ulDC_CCTX_Handle , CCTX_QUEUE_NAME) ; 

if (ulStatus != 0) 

{ 

DosSleep (1000L); 



} 

} 

while (ulStatus != 0) ; 



memset ( &tDevice_Str , 0, sizeof ( tDevice_Str ) ) ; 

/* get rid of compiler warning * / 
puchData = (PUCHAR) pvDummy; 



for (ilNDXl = 0; ilNDXl < MAX_NUM_VENDORS ; + + HNDX1) 
{ 

for (iINDX2 = 0; iINDX2 < DC MAX EVENT; ++HNDX2) 



/* Set up MACK and EUCO message */ 
LIB_cnv_ascii_to_ebcdic (MSG_ID__MACK, 

(PUCHAR) &DC_MACK_Msg.mack_id,MSG_ID_TYPE_MAX) ; 
L I B__c n v_a s c i i _ t o_e bcdic (MSG_I D_E U C 0 , 

(PUCHAR) &EUC0_Msg. type, MSG_ID_TYPE_MAX) ; 
EUC0_Msg. trans_rev_lvl = LIB_MSG_EUCO_REV; /* transactn. revision level 



/* Get time for next RESEND message to devices (3AM on the next day) */ 
ulTempTime = SHTIM_time { ) ; 

ulResendTime = ((ulTempTime / SECONDS_PER_DAY) * SECONDS_PER_DAY) + 
SECONDS_PER__DAY; 

ulResendTime += SIX_HOURS; /* set to 6 hours passed midnight GMT*/ 
ulWaitTime = (ulResendTime - ulTempTime) * 1000; 



/* Wait 10 seconds for FEP to init V 
DosSleep (10000L) ; 

while (usRunning) 
{ 



ulStatus = DosWaitEventSem (DC_QRead_Sem, ulWaitTime) ; 

/* Check if a message was read or if we timed out in the read */ 

if (ulStatus == 0) 

{ 

usMsgRead = TRUE; 
usFreeMsg= TRUE; 

} 

else if (ulStatus == ERROR_TIMEOUT ) 
{ 



tDevice_Str [ilNDXl] .usState [HNDX2] = DC_IDLE; 
tDevice_Str [ilNDXl] . ulTime [ HNDX2 ] = ULONG_MAX; 



EUC0_Msg. last_block - 1; 
EUC0_Msg . cics_trans_no . v = 0; 
EUC0_Msg . sequence_no . v = 0; 
EUC0_Msg. length. v = 0; 



/* last msg. block specfier */ 
/* msg. id of sending task */ 



/* message block/sequence no */ 
/* length of data block */ 



usMsgRead = FALSE; 
usFreeMsg= FALSE; 

} 

else /* some very serious error */ 
{ 

usRunning = FALSE; 

SH_REPORT_EVENT ( FAT AL_E VENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE, ulStatus, 

"Error Returned by DosWaitEventSem" ) ; 
break; 

} 

if (usMsgRead) 
{ 

ulStatus = UtReadQ (ulDEB_CRED_handle , 

&qdata, 
&usQlen, 
&usMsgCode , 
&usMsgSubcode, 
&puchData , 
NULL, 

(PVOID) &ptMsg, 
DC, 

&iQpri, 
DCWW_NOWAIT, 
&DC_QRead_Sem, 
0); 

if (ulStatus != 0) 
{ 

usMsgRead = FALSE; 
usFreeMsg= FALSE; 

if {ulStatus != ERROR_QUE_EMPTY) 
{ 

usRunning = FALSE; 

SH_REPORT_EVENT ( FATAL_EVENT, SH_STATUS_SWERR, 

SH_STATUS_IGNORE, ulStatus, 

"Error Returned by UtReadQ"); 
break; 

} 

} 

} 

/* get the current time */ 
ulCurrentTime = SHTIM_time ( ) ; 
uchMachinelndex = 0; 
uchEvent Index = 0; 
usMore_to_do = TRUE; 

/* Init next wait time for UTREADQ to INFINITWAIT, change it later 

if there are any devices still waiting for a response */ 
ulWaitTime = ULONG MAX; 



/* Main loop to process at most one incoming message if received and 
check for 

timeouts for all devices */ 
while (usMore_to_do) 
{ 

/* First figure out what task to do, eithe an incoming message or 

timeout 

for a specific device for a specific event (SECURE, DELETE, or 

EUC2 message) */ 

usProcMsgld = 0; 

usMsgSent = FALSE; /* No messages sent to and device yet */ 

if ( (usMsgRead) && (usMsgCode == DC_MSG) ) 

{ 

/* If this is a message from the threads message queue */ 
/* set message code to process */ 

usProcMsgld = DC_CheckNAK (puchData, usMsgSubcode, 
&uchStrIndex, SuchMachine) ; 

usMsgRead = FALSE; 

} 

else if (ulCurrentTime > ulResendTime) 
{ 

/* We have passed the resend time (2AM) */ 

ulResendTime += SECONDS PER DAY; /* Reset next time to 24 houi 



later */ 



usProcMsgld = DC_RESEND; 



else 
{ 

/* Check for timeouts on previous messages sent to devices */ 
usCheck_f or_timeouts = TRUE; 
while (usCheck_f or_timeouts ) 
{ 

usCheck_f or_timeouts = 
DC_CheckTimeout s (uchMachinelndex, uchEvent Index, 

&usProcMsgId, ulCurrentTime, 
SulWaitTime , &uchStrIndex, 

&uchMachine) ; 

++uchMachine Index; 
if (uchMachinelndex MAX_NUM_VENDORS ) 
{ 

/* All devices have been checked for this event. */ 
/* Check next event (timeout events are for EUC2, 
SECURE, or DELETE messages) */ 

uchMachinelndex = 0; /* Start with first device index 

for next event */ 

++uchE vent Index; 

if (uchEventlndex DC_MAX_EVENT ) 
{ 

/* All devices have been checked for all timeout 

/ 

usMore_to_do = FALSE; 
usCheck for timeouts = FALSE; 



events , 



/* Now that a task has been determined for this time through the 
loop, go do it. */ 

switch (usProcMsgld) 
{ 

case DC_TRANS_GET: 

uchMachine = *puchData; 
if ((uchMachine > MAX_VE N DO R_AD DRESS ) || (uchMachine < 
START_VENDOR_ADDRESS) ) 

{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE, MC_STATUS_IGNORE , 
(API RET) uchMachine, 
"SMADDEB ... invalid machine id in get trans message."); 



else 



transactions */ 



DC IDLE) 



/* message from SMADSTAT thread to start getting DC 

uchStr Index = uchMachine - START_VENDOR_ADDRESS; 

if (tDevice Str [uchStrlndex] . usState [ DC SECURE EVENT] == 



{ 

DC__SendTranReq ( &tDevice_Str [uchStrlndex] , 

uchMachine, ulCurrentTime ) ; 

usMsgSent = TRUE; 

} 

else 



flag to 
complete in 
messages sent 



&usMsgSent ) ; 



/* We are already requesting transactions, set a 

request again when current transaction receive is 

case there is some timing problem with STATUS 

and the last TRANSACTION SECURE response */ 
tDevice^Str [uchStrlndex] . usTryAgain = TRUE; 

} 

} 

break; 

case DC_TRANS_TIMEOUT: 
if (ulDC_Debug) 
{ 

ulStatus = STATCommlnitVer (uchMachine, &iVer) ; 

if (iVer) 

{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE , MC_STATUS_I GNORE , 
(API RET) uchMachine, 
"SMADDEB. . .get trans timeout."); 

} 

} 

/* Timed out waiting on getting DC transactions */ 
DC_ProcTranTimeout (uchMachine, uchStrlndex, ulCurrentTime, 



break; 



case DC_TRANS: /* This is an EUC3,EUC4, or EUC5 

from the device */ 

case DC_AUTHORIZE: /* This is an EUC1 or EUC6 from the 

device */ 

ptDC_Trans_Msg = (DC__TRANS_RESPONSE *) puchData; 
uchMachine = ptDC_Trans_Msg->uchMachine ; 
if ((uchMachine > MAX_VENDOR_ADDRESS ) || (uchMachine < 
START_VENDOR_ADDRESS ) ) 

{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE, MC_STATUS_IGNORE , 
(APIRET) uchMachine, 
"SMADDEB ... invalid machine id in trans message."); 

} 

else 
{ 

uchStrlndex = uchMachine - START_VENDOR_ADDRESS ; 
/* Check for a zreo length size, which means no more 
transacations available. */ 

if (ptDCJTrans_Msg->EUC_Msg. tHDR . usLength != 0) 
{ 

DC_Proc_Trans (ptDC_Trans_Msg, uchMachine, 

uchStrlndex, 

ulCurrentTime, usProcMsgld) ; 
/* Set Msg Sent flag so that we will check timeouts 

*/ 

usMsgSent = TRUE; 

} 

else if (tDevice_Str [uchStrlndex] . usTryAgain == TRUE) 
{ 

/* Request starting from first block of new message 

*/ 

DC_SendTranReq ( &tDevice_Str [uchStrlndex] , 

uchMachine, ulCurrentTime) ; 

usMsgSent = TRUE; 

} 

else 
{ 

/*■ Min size transaction means no more transactions 

at the device */ 

tDeviceJStr [uchStrlndex] . usRetryCount [DC_SECURE_EVENT] = 0; 

tDevice Str [uchStrlndex] . ulTime [ DC SECURE EVENT] = 



UL0NG_MAX; 
DC IDLE; 



tDevice_Str [uchStrlndex] ,usState[DC SECURE EVENT] = 



} 

break; 

case DC_SECURE: 

ptDC_ACK_Msg = ( DC_SECURE_DEL_RESPONSE *) puchData; 
uchMachine = ptDC_ACK_Msg->uchMachine; 



if ((uchMachine > MAX_VENDOR_ADDRESS) || {uchMachine < 
START_VENDOR_ADDRESS) ) 

{ 

SH_REPORT__EVENT ( ETDebugOutput , 
MC_STATUS_NONE, MC_STATUS_IGNORE , 
(API RET) uchMachine, 
"SMADDEB ... invalid machine id in secure message."); 



} 

else 
{ 



DC_WAITING_ACK) 

new message */ 
zero length 



uchStr Index = uchMachine - START_VENDOR_ADDRESS; 

if (tDevice_Str [uchStrlndex] . usState [ DC_SECURE_EVENT] == 

{ 

/* This ACK matches the expected response */ 

/* Request a new trans starting from first block of 

/* Always keep requesting new trnasactions until a 

transaction arrives */ 
if (tDevice_Str [uchStrlndex] .usTryAgain == TRUE) 



uchMachine, ulCurrentTime ) 



{ 



} 

else 
{ 



DC_SendTranReq ( &tDevice_Str [uchStrlndex] , 
usMsgSent = TRUE; 

/* no more transactions at the device */ 



tDevice_Str [uchStrlndex] . usRetryCount [ DC_SECURE_EVENT] = 0; 

tDevice_Str [uchStrlndex] .ulTime [ DC_SECURE_EVENT] 

= ULONG_MAX; 

tDevice_Str [uchStrlndex] . usState [ DC_SECURE_EVENT ] = DC_IDLE; 

} 

} 

} 

break; 

case DC_SECURE_NAK: 
case DC_SECURE_TIMEOUT: 

if (ulDC_Debug) 

{ 

if {usProcMsgld == DC__SECURE_TIMEOUT) 
{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE, MC_STATUS_IGNORE , 
(APIRET) uchMachine, 

"SMADDEB ... DC Secure Timeout " ) ; 

} 



DC WAITING ACK) 



if (tDevice_Str [uchStrlndex] . usState [DC_S ECU RE_E VENT] 
{ 



if 

(tDevice^Str [uchStrlndex] . usRetryCount [ DC_SECURE_EVENT ] < DC_MAX_RETRY) 

{ 

/* Send it again and increment the count for number 

of times sent*/ 

++ (tDevice_Str [uchStrlndex] . usRetryCount [ DC_SECURE_EVENT] ) ; 

/* Check that device is past the comms init stage */ 
ulStatus = STATCommlnitVer (uchMachine, &iVer ) ; 
if (iVer) 
{ 

ulStatus = FEPMessage ( 0, (UINT) uchMachine, 

TX_DC_SECURE, 

RETRIEVAL_REF_NUMBER_MAX, 

&tDevice_Str [uchStrlndex] . uchSecureRef No [ 0 ] , 



SH_STATUS_SWERR, 
FEPMessage") ; 



0); 



if (ulStatus 
{ 



0) 



SH_REPORT_EVENT ( WARN I NG_E VEN T , 

SH_STATUS_IGNORE, ulStatus, 
"Error Returned by 



else 
{ 

if (ulDCJDebug) 
{ 

SH_REPORT_EVENT (ETDebugOutput , 

MC_S TAT US_NONE , MC_STATUS_I GNORE , 
{ APIRET ) uchMachine , 

"SMADDEB. . . SECURE Send Again 1 ') ; 



DC_WAITING_ACK; 
ulCurrentTime ; 



} 

} 

usMsgSent = TRUE; 

tDevice_Str [uchStrlndex] . usState [DC_SECURE_EVENT] = 
tDevice_Str [uchStrlndex] . ulTime [DC SECURE EVENT] = 



} 

else 
{ 



SH_STATUS_SWERR, 
(ULONG) uchMachine, 
TransSecure from Device"); 



/* Time to give up on sending this message */ 

if (usProcMsgld == DC_SECURE_TIMEOUT) 

{ 

SH_REPORT_EVENT ( WARN ING_EVENT , 
S H_S TATU S__I GNORE , 
"Timeout Waiting for DC 

} 

if (tDevice_Str [uchStrlndex] . usTryAgain == TRUE) 



of new message */ 
a zero length 

uchMachine, ulCur rent Time ) 



/* Request a new trans starting from first block 

/* Always keep requesting new trnasactions until 

transaction arrives */ 
DC_SendTranReq { &tDevice_Str [uchStrlndex] , 

usMsgSent = TRUE; 

} 

else 
{ 

/* no more transactions at the device */ 

tDevice_Str [uchStrlndex] . usRetryCount [DC_SECURE_EVENT] = 0; 

tDevice_Str [uchStrlndex] , ulTime [ DC_SECURE_EVENT ] 

= ULONG_MAX; 

tDevice_Str [uchStrlndex] . usState [ DC_SECURE_EVENT] = DC_IDLE; 

} 

} 

} 

break; 



transaction */ 



transaction 



case DC_DELETE_TRANS : 

/* message from SHDBCRDT (SendToDevice ) to delete a 

ptDC_DelTrans = ( DC_DEL_TRANS *) puchData; 

/* Build the retrieval reference number to ID this 



at the device, and get device number */ 
uchMachine = ptDC_DelTrans->uchMachine ; 

if ((uchMachine > MAX_VENDOR_ADDRESS ) || (uchMachine < 
START_VENDOR_ADDRESS) ) 

{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_S TAT U S_N0N E , MC_S TAT U S_I GNORE , 
(APIRET) uchMachine, 
"SMADDEB. .. invalid machine id in trans message."); 

} 

else 
{ 

uchStrlndex = uchMachine - START_VENDOR_AD DRESS ; 

if (tDevice_Str [uchStrlndex] . usState [ DC_DELETE_EVENT] == 

DC_IDLE) 

{ 



/* Save the CICS in local structure for usage in 

MACK reply later. */ 

tDevice_Str [uchStrlndex] .ulCICS - ptDC_DelTrans- 

>ulCICS; 

memcpy (tDevice_Str [uchStrlndex] . uchMackType, 
ptDC_DelTrans->uchMackType, 
MSG ID TYPE MAX) ; 



subsequent comms with 



/* Save the retrieval reference number for 

the device. */ 
memcpy ( &tDevice_Str [uchStrlndex] . uchDeleteRef No, 
&ptDC_DelTrans->auchRefNum[0] , 
RETR I E VAL_RE F_NUMBER_MAX ) / 

/* Check that device is past the comms init stage */ 
ulStatus = STATCommlnitVer (uchMachine, &iVer) ; 
if (iVer) 
{ 

ulStatus = FEPMessage ( 0, (UINT) uchMachine, 

TX DC DELETE, 



RETRIEVAL_REF_NUMBER__MAX, 

StDevice Str [uchStrlndex] . uchDeleteRef No [ 0] , 



0) ; 



SH_STATUS__SWERR, 
FEPMessage") ; 



if (ulStatus != 0) 
{ 

SH_REPORT_EVENT ( WARNING_EVENT , 

SH_STATUS_IGNORE, ulStatus, 
"Error Returned by 

} 

else 
{ 

if (ulDC_Debug) 
{ 

sprintf (auchTmpMsg, "DELETE : " ) ; 
/*Write__Log_Msg ( "del . hex" , 



(PUCHAR) 

RETRIEVAL REF NUMBER MAX);*/ 



auchTmpMsg, 

&tDevice_Str [uchStrlndex] . uchDeleteRef No [0] , 

} 

} 

} 

tDevice_Str [uchStrlndex] . usState [DC_DELETE_EVENT] 
tDevice_Str [uchStrlndex] . ulTime [ DC_DELETE_EVENT] = 



DC_WAITING_ACK; 
ul Cur rent Time ; 



tDevice_Str [uchStrlndex] . usRet ryCount [ DC__DELETE__EVENT ] = 0; 

usMsgSent = TRUE; 



else 



uchMachine, 
Busy") ; 



/* Let the DSM retry later */ 

S H_RE P0RT_E VENT ( WARN I NG_E VENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE , ( ULONG ) 

"DC Delete Request, Machine 



} 

break; 



this. */ 



case DC_DELETE_ACK: 

/* Set up MACK message V 

/* Note that uchStrlndex is set in DC_CheckNAK prior to 



DC WAITING ACK) 



if (tDevice__Str [uchStrlndex] . usState [ DC_DELETE_EVENT] == 
{ 



/* Add ' EUCx' type to mack msg */ 
memcpy ( &DC_MACK_Msg . type, 

tDevice__Str [uchStrlndex] . uchMackType, 

MSG_ID_TYPE_MAX) ; 
/* Add CICS trans no to MACK */ 
DC_MACK_Msg . cics_trans_no . v = 
tDevice^Str [uchStrlndex] .ulCICS; 

DC_MACK_Msg. status = MSG_ACKSTS OK; 



MSG C MACKSI2E, 



if ( !DBCRDT_SendToHost ( (PUCHAR) &DC_MACK_Msg, (ULONG) 

{PUCHAR) &auch!nfo) ) 



{ 



SH_REPORT_EVENT ( WARN ING__EVENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE, (APIRET) 0, 
"DC Thread can not MACK host"); 



- 0; 

ULONG_MAX; 
DC IDLE; 



this. */ 
DC_WAITING_ACK) 
response */ 
0; 

ULONG^MAX; 
DC IDLE; 



tDevice_Str [uchStrlndex] . usRetryCount [ DC_DELETE_EVENT] 
tDevice_Str [uchStrlndex] . ulTime [ DC_DELETE_EVENT] - 
tDevice_Str [uchStrlndex] . usState [ DC_DELETE_EVENT] = 

} 

break; 

case DC_DELETE_NAK: 

/* Note that uchStrlndex is set in DC_CheckNAK prior to 

if (tDevice__Str [uchStrlndex] . usState [DC_DELETE_EVENT] 
{ 

/* Timed out and exceeded allowed attempts to get 

/* Time to give up on sending the DELETE message */ 
tDevice__Str [uchStrlndex] . usRetryCount [DC_DELETE__EVENT] = 

tDevice_Str [uchStrlndex] .ulTime [DC_DELETE_EVENT ] = 

tDevice_Str [uchStrlndex] .usState [DC DELETE EVENT] = 



else 

{ /* Wrong state, just set flag to check for timeouts */ 
usMsgSent = TRUE; 

if (tDevice_Str [uchStrlndex] . ulErrorCount < ULONG_MAX) 
{ 

++tDevice_Str [uchStrlndex] . ulErrorCount; 

} 

} 

break; 

case DC_DELETE__TIMEOUT : 
if (ulDC_Debug) 
{ 

if (usProcMsgld == DCJDELETEJTIMEOUT ) 
{ 

SH_REPORT_EVENT { ETDebugOutput , 
MC_STATUS_NONE , MC_STATUS_IGNORE , 
(API RET) uchMachine, 

"SMADDEB ... DC Delete Timeout"); 

} 

} 

if {tDevice_Str [uchStrlndex] . usState [DC_DELETE EVENT] == 



DC WAITING ACK) 



if 

(tDevice_Str [uchStrlndex] . usRet ryCount [DC DELETE EVENT] < DC DEL MAX RETRY) 



{ 



of times sent*/ 



/* Send it again and increment the count for numbe 



+ + (tDevice_Str [uchStrlndex] . usRet ryCount [DC__DELETE_EVENT] ) ; 

/* Check that device is past the comms init stage 
ulStatus = STATCommlnitVer (uchMachine, &iVer) ; 
if (iVer) 

{ 

ulStatus = FEPMessage ( 0, (UINT) uchMachine, 

TX__DC_DELETE , 

RET RI EVAL_RE F_NUMBER_MAX , 

&tDevice_Str [uchStrlndex] . uchDeleteRef No [ 0] , 

if (ulStatus != 0) 



0) ; 



SH_STATUS_SWERR, 
FEPMessage") ; 



SH_REPORT_EVENT ( WARNING_EVENT , 

SH_STATUS_IGNORE, ulStatus 
"Error Returned by 

} 

else 
{ 

if (ulDC_Debug) 



{ 



SH_REPORT_EVENT (ETDebugOutput, 

MC STATUS NONE, MC STATUS IGNORE, 



( APIRET ) uchMachine , 

"SMADDEB. . .Resend DELETE DC Trans 



to Device") ; 



ulCur rent Time; 



response */ 



} 



} 



} 

tDevice_Str [uchStrlndex] .ulTime [DC_DELETE_EVENT ] = 
usMsgSent = TRUE; 

} 

else 

{ /* Timed out and exceeded allowed attempts to get 
/* Time to give up on sending the DELETE message */ 



tDevice_Str [uchStrlndex] . usRetryCount [DC_DELETE__EVENT] = 0; 

tDevice_Str [uchStrlndex] . ulTime [ DC_DELETE_EVENT] = 

ULONG_MAX; 
DC IDLE; 



uchMachine, 
DC Trans") ; 



tDevice_Str [uchStrlndex] .usState [ DC_DELETE_EVENT] = 

SH_REPORT_EVENT ( WARNING_EVENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE, (ULONG) 

"Device did not ACK Delete 



} 



} 

else 

{ /* Wrong state, just set flag to check for timeouts */ 
usMsgSent = TRUE; 

if (tDevice_Str [uchStrlndex] . ulErrorCount < ULONG_MAX) 
{ 

++tDevice_Str [uchStrlndex] . ulErrorCount; 

} 

} 

break; 
case DC_EUC2: 

/* This is an EUB2 or EUC2 comming from CC via SHDEBCRD via 
SendToDevice function . 

Send this on to the device and if successfull, send a 

MACK back to the 

SHDEBCRD thread. If we know this can not be sent to the 

device, send a NAK 

back to the SHDEBCRD thread. */ 

ptDC_Ext_EUC_Msg = ( DC_EXTERNAL_EUC_MSG *) puchData; 
uchMachine = ptDC_Ext__EUC_Msg->uchMachine ; 
if ((uchMachine > MAX_VENDOR_AD DRESS ) || (uchMachine < 
3TART_VEND0R_ADDRESS) ) 

{ 

SH_REPORT_EVENT (ETDebugOutput , 
MC_STATUS__NONE, MC_STATUS_IGNORE , 
(APIRET) uchMachine, 

"SMADDEB. .. invalid machine id in trans message."); 

} 

else 



{ 

uchStr Index = uchMachine - START VENDOR ADDRESS; 



if (ulDC_Debug) 
{ 

if (ptDC_Ext_EUC_Msg->tHDR. type [MSG_ID_TYPE_MAX-2] 

{ 

sprintf (auchTmpMsg, 

"SMADDEB. . .DC EUB2 rcvd for Device %2i.",(INT) 

} 

else 
( 

sprintf (auchTmpMsg, 

"SMADDEB ... DC EUC2 rcvd for Device %2i.",(INT) 

} 

S H_RE PORT_E VENT ( ETDebugOutput , 

MC_STATUS_NONE, MC_STATUS_IGNORE, (APIRET) 0, 

} 

DC_ProcEUC2 (uchMachine, uchStrlndex, ulCurrentTime, 
usMsgSent = TRUE; 

if ( (ulWaitTime ULONG_MAX) || (ulWaitTime > 

{ 

ulWaitTime = DC_EUC2_MAX_WAIT; 

} 

} 

break; 



case DC_EUC2_ACK: 

/* Note that uchStrlndex is set in DC_CheckNAK prior to 

this. */ 

if (tDevice_Str [uchStrlndex] . usState [ DC_EUC2_EVENT ] == 

DC_TRANS_ACK) 

{ 

DC_ProcEUC2_ACK (uchMachine, uchStrlndex, ulCurrentTime, 

&usMsgSent) ; 

} 

else 
{ 

/* Wrong state, something went wrong. */ 

if (tDevice_Str [uchStrlndex] . ulErrorCount < ULONG_MAX) 

{ 

++tDevice_Str [uchStrlndex] . ulErrorCount ; 

} 

usMsgSent = TRUE; 

} 

break; 
case DC EUC2 NAK: 



== DC_EBCDIC_B) 
uchMachine) ; 

uchMachine) ; 

auchTmpMsg) ; 
ptDC_Ext_EUC_Msg) ; 
DC_EUC2_MAX_WAIT) ) 



case DC_EUC2_TIME0UT: 
if (ulDC_Debug) 
{ 

if (usProcMsgld == DC_EUC2_TIME0UT) 
{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC_STATUS_NONE, MC_STATUS_IGNORE, 
(APIRET) 0, 

"SMADDEB ... DC Authorization Timeout"); 

} 

} 

/* Note that uchStrlndex is set in DC_CheckNAK prior to 

/* treat a NAK same as a timeout, resenci the same block * 
if (tDevice_Str [uchStrlndex] . usState [DC_EUC2_EVENT] == 

f 

DC_ProcEUC2_NAK ( uchMachine, uchStrlndex, 
ulCurrentTime, &usMsgSent) ; 

} 

break; 

case DC_RESEND: 

if (ulDC_Debug) 
{ 

SH_REPORT_EVENT (ETDebugOutput, 
MC__STATUS_NONE, MC_STATUS ^IGNORE , 
(APIRET) 0, 

"SMADDEB. . . DC Resend."); 

} 

uchStart = 0; 
uchEnd = MAX_NUM_ VENDORS; 

for (uchStrlndex = uchStart; uchStrlndex < uchEnd; 
++uchStrIndex) 

{ 

uchMachine = uchStrlndex + S T ART_VE N DO R_AD DRESS ; 

if (DC_Device (uchMachine) ) 

{ 

if 

( (tDevice_Str [uchStrlndex] . usState [ DC_SECURE_EVENT] == DC_IDLE) && 

(tDevice_Str [uchStrlndex] . usState [DC_DELETE_EVENT] == DC_IDLE) ) 

{ 

/* Check that device is past the comms init 

stage */ 

ulStatus = STATCommlnitVer (uchMachine, &iVer) ; 

if (iVer) 

{ 

ulStatus - FEPMessage (0, (UINT) 

uchMachine, 

TX_DC_RESEND, 
(PVOID) NULL, 

0); 

if (ulStatus != 0) 
{ 



this. */ 
DC_T RAN S_AC K ) 
usProcMsgld, 



the timeout and 

SH_STATUS_SWERR, 
ulStatus , 
FEPMessage" ) ; 



/* If there was a failure, just rely on 

try again later */ 
SH_REPORT_EVENT ( WARNING_EVENT , 

SH_STATUS_IGNORE / 

"Error Returned by 



else 



Sent") ; 



if (ulDC_Debug) 
{ 

SH_REPORT_EVENT (ETDebugOutput , 

MC_STATUS_NONE, MC_STATUS_IGNORE, 
(APIRET) uchMachine, 
"SMADDEB. . . RESEND DC Tran Msg 



} 

/* Clear field used to check for resending 

this message */ 

tDevice_Str [uchStrlndex] . ulTime [ DC_RESEND_EVENT] = ULONG_MAX; 

tDevice_Str [uchStrlndex] . usState [DC_RESEND_EVENT] - DC_IDLE; 

} 

else 

{ /* Set a time to try again later */ 

tDevice_Str [uchStrlndex] . ulTime [ DC_RESEND_EVENT ] = ul Cur rent Time ; 

tDevice_Str [uchStrlndex] . usState [DC_RESEND_EVENT] = DC_WAITING_ACK; 

usMsgSent = TRUE; 

} 

} 

else 

{ /* Set a time to try again later */ 

tDevice^Str [uchStrlndex] . ulTime [DC_RESEND_EVENT] 

= ulCurrentTime; 

tDevice_Str [uchStrlndex] . usState [ DC_RESEND_EVENT] - DC_WAITING_ACK; 

usMsgSent = TRUE; 



} 



} 



} 

/* Also send up an EUCO to test the CC comms */ 

if (EUC0__Msg. cics_trans_no. v == LONG_MAX) 

{ 



EUCO_Msg.cics_trans_no. v = 0; 



} 

else 



++EUC0_Msg . cics_trans no . v; 



host") 



if ( ! DBCRDT_SendToHost ( ( PUCHAR) & EUC0_Msg, 
( ULONG ) MSG_C_HEADERSIZE, 
( PUCHAR) &auchInfo) ) 



{ 



SH_REPORT_EVENT ( WARNING_EVENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE, (APIRET) 0, 
"DC Thread can not send EUCO to 



break; 



case DC_RESEND_TIMEOUT: 

uchMachine = uchStr Index + START_VENDOR_ADDRESS ; 

if ((tDevice Str [uchStr Index] . usState [DC SECURE EVENT] == 



DC_IDLE) && 
DC IDLE) ) 



{ 



(tDevice Str [uchStr Index] . usState [DC DELETE EVENT] == 



if 



(tDevice_Str [uchStr Index] . usRetryCount [ DC_RESEND_EVENT] < DC_MAX_RESEND_RETRY) 

{ 

/* Check that device is past the comius init stage */ 
ulStatus = STATCommlnitVer (uchMachine, &iVer) ; 
if (iVer) 
{ 

++(tDevice_Str [uchStrlndex] . usRetryCount [ DC_RESEND_EVENT] ) ; 

ulStatus = FEPMessage (0, (UINT) uchMachine, 

TX__DC_RESEND, 0, 
(PVOID) NULL, 0); 

if (ulStatus != 0) 



{ 



timeout and 

SH_STATUS_SWERR, 
ulStatus , 
FEPMessage" ) ; 



/* If there was a failure, just rely on the 

try again later */ 
SH_REPORT_EVENT ( WARNING^EVENT , 

SH_STATUS_IGNORE , 

"Error Returned by 



Again") ; 



message */ 



} 

else 
{ 

if (ulDC_Debug) 
{ 

SH_REPORT_EVENT ( ETDebugOutput , 

MC_STATUS_NONE, MC_STATUS_IGNORE, 
(APIRET) uchMachine, 

"SMADDEB. . .RESEND Msg Sent 

} 

} 

/* Clear field used to check for resending this 



tDevice_Str [uchStrlndex] . ulTime [ DC_RESEND_EVENT ] 

= ULONG_MAX; 

tDevice_Str [uchStrlndex] . usState [ DC_RESEND_EVENT ] = DC_IDLE; 

tDevice_Str [uchStrlndex] . usRetryCount [ DC_RESEND_EVENT] = 0; 

} 

else 
{ 

/* give up, try again next 2am */ 

tDevice_Str [uchStrlndex] . ulTime [ DC_RESEND_EVENT] 

- ULONG_MAX; 

tDevice_Str [uchStrlndex] . usState [ DC_RESEND_EVENT] - DC_IDLE; 

tDevice_Str [uchStrlndex] . usRetryCount [DC_RESEND_EVENT] = 0; 

} 

} 

else 
{ 

/* exceeded max retries, do not send anymore */ 
/* Clear field used to check for resending this 

message */ 

tDeviceJStr [uchStrlndex] . ulTime [DC_RESEND_EVENT] = 

UL0NG_MAX; 

tDevice_Str [uchStrlndex] . usState [ DC_RESEND_EVENT] = 

DC_IDLE; 

tDevice_Str [uchStrlndex] . usRetryCount [ DC_RESEND_EVENT ] = 0; 

} 

} 

else 
{ 

/* give up, try again next 2am */ 

t Device jStr [uchStrlndex] . ulTime [ DC_RESEND_EVENT] = 

UL0NG_MAX; 

tDevice_Str [uchStrlndex] . usState [DC_RESEND_EVENT] = 

DC_IDLE; 

tDevice_Str [uchStrlndex] .usRetryCount [ DC_RESEND_EVENT ] = 

0; 

} 

break; 



case DC_EUC0 : 

/* Set up EUCO message */ 

/* Add CICS trans no */ 

if (EUC0_Msg. cics_trans_no. v == LONG_MAX) 
{ 

EUC0_Msg. cics_trans_no. v = 0; 

} 

else 
{ 

++EUC0_Msg . cics_trans_no . v; 

} 



if ( !DBCRDT_SendToHost ( (PUCHAR) & EUCO_Msg, 
(ULONG) MSG_C_HEADERSIZE, 
(PUCHAR) Sauchlnfo) ) 

{ 

SH_REPORT_EVENT ( WARN I NG_EVENT , SH_STATUS_SWERR, 

SH_STATUS_IGNORE, (APIRET) 0, 
"DC Thread can not send EUCO to 

host") ; 

} 

else 
{ 

bEUCO_Pending = TRUE; 

} 

break; 

case DC_EUCO_RSP: 

/* EUCO response message from CC*/ 

if (bEUCO_Pending == TRUE) 

{ 

bEUCO_Pending - FALSE; 

} 

else if (ulCurrentTime - ulEUCO_Time > 60*3) 
{ 

/* If more than 3 minutes since last, send R-side eucO*/ 
/* Add CICS trans no */ 

if (EUCO_Msg.cics_trans_no. v == LONG_MAX) 
{ 

EUC0_Msg . cics_trans_no . v = 0; 

} 

else 
{ 

++EUC0_Msg . cics_trans_no . v; 

} 

if ( ! DBCRDT_SendToHost ( (PUCHAR) & EUC0_Msg, 
(ULONG) MSG_C_HEADERS I ZE , 
(PUCHAR) Sauchlnfo) ) 

{ 

SH_REPORT_EVENT ( WARNING_EVENT , SH_STATUS_SWERR, 
SH_STATUS_IGNORE, (APIRET) 0, 
"DC Thread can not send EUCO to 

host") ; 

} 

bEUC0_Pending - TRUE; 
ulEUCO Time = ulCurrentTime; 



breaks- 
default : 
break; 

} /* switch (usProcMsgld) */ 



/* If a message was sent, then set the timeout value */ 



■'if ( (usMsgSent) && (ulWaitTime — ULONG MAX) ) 

/ ( 

/ ulWaitTime = DC_MAX_WAIT; 
} 



} /* while (usMore_to_do) */ 

if (ulWaitTime == ULONG_MAX) 
{ 

/* do not wait longer than next time to send RESEND message to 

devices */ 

ulWaitTime = (ulResendTime - ulCurrentTime) * 1000; 

} 

if (usFreeMsg) 
{ 

usFreeMsg= FALSE; 

ulStatus = UtMsgFree (ptMsg, usQlen, DC) ; 

if (ulStatus != 0) 

{ 

SH_RE PORT_E VENT (FATAL_E VENT, SH__STATUS_SWERR, 
SH_STATUS_IGNORE, ulStatus, 
"Error Returned by UtMsgFree"); 

} 

} 

} /* (while (usRunning == TRUE);*/ 



